home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap10 / howto04 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-12  |  150.0 KB  |  4,363 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  8.   CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : String; { Connection profile; used in lists }
  15.     CIPAddress : String; { Dotted character IP Address       }
  16.     CUserName  : String; { Login name to site; can be anonym }
  17.     CPassword  : String; { Password; won't be shown          }
  18.     CStartDir  : String; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   { This record is used to hold information about a newsgroup            }
  23.   { NOTE : hi and low pointers indicate either dl or trashing without dl }
  24.   { "read" is for an article dl'd but not trashed.                       }
  25.   PNewsGroupRecord = ^TNewsGroupRecord;
  26.   TNewsGroupRecord = record
  27.     GName                : String;  { Profile of the newsgroup              }
  28.     GRealName            : String;  { Real Newsrc name of the newsgroup     }
  29.     GLowest              : Longint; { Number of lowest dl/trashed article   }
  30.     GHighest             : Longint; { Number of highest dl/trashed article  }
  31.     GTotalNew            : Longint; { Total New articles available          }
  32.     GTotalAvailable      : Longint; { After update, shows how many arts on s}
  33.     GLowestAvailable     : Longint; { au, shows lowest a# on server         }
  34.     GHighestAvailable    : Longint; { au, shows highest a# on server        }
  35.     GPostable            : Boolean; { Can post to newsgroup                 }
  36.     GSubscribed          : Boolean; { Subscribed to newsgroup               }
  37.     GTotalArticles       : Longint; { Total articles maintained on system   }
  38.     GTotalUnReadArticles : Longint; { Total unread articles on system       }
  39.     GIDNumber            : Integer;
  40.     GFileName            : String;  { Name of file holding articles records }
  41.     GLTag                : Longint; { Tag field to hold pointer to arts TL  }
  42.   end;
  43.   NGRFile = file of TNewsGroupRecord; { File type for NGRec }
  44.   { This record is used to hold information about Newsgroup articles }
  45.   PNewsGroupArticleRecord = ^TNewsGroupArticleRecord;
  46.   TNewsGroupArticleRecord = record
  47.     NGAGroupname   : String;  { Newsgroup name (redundancy safeguard)     }
  48.     NGASubject     : String;  { Subject of article                        }
  49.     NGANumber      : Longint; { Article number                            }
  50.     NGADownloaded  : boolean; { Article attempted/succeeded downloading   }
  51.     NGASender      : String;  { Article's putative sender (CIUPKC158=us)  }
  52.     NGARead        : Boolean; { Article read flag                         }
  53.     NGAPosted      : Boolean; { Article posted flag                       }
  54.     NGAArtFileName : String;  { Name of system-gen file with article text }
  55.   end;
  56.   NGARFile = file of TNewsGroupArticleRecord;
  57.   TCCINetCCForm = class(TForm)
  58.     MainMenu1: TMainMenu;
  59.     Network1: TMenuItem;
  60.     N1: TMenuItem;
  61.     Exit1: TMenuItem;
  62.     Services1: TMenuItem;
  63.     IPAddress1: TMenuItem;
  64.     EMail1: TMenuItem;
  65.     FTP1: TMenuItem;
  66.     UsenetNws1: TMenuItem;
  67.     Panel1: TPanel;
  68.     Panel2: TPanel;
  69.     Panel3: TPanel;
  70.     Panel4: TPanel;
  71.     Panel5: TPanel;
  72.     Panel6: TPanel;
  73.     ListBox1: TListBox;
  74.     Panel7: TPanel;
  75.     SpeedButton1: TSpeedButton;
  76.     SpeedButton2: TSpeedButton;
  77.     ListBox2: TListBox;
  78.     ComboBox1: TComboBox;
  79.     Button1: TButton;
  80.     Memo1: TMemo;
  81.     Files1: TMenuItem;
  82.     Edit1: TMenuItem;
  83.     Encoding1: TMenuItem;
  84.     EMail2: TMenuItem;
  85.     FTP2: TMenuItem;
  86.     News1: TMenuItem;
  87.     Load1: TMenuItem;
  88.     Save1: TMenuItem;
  89.     Cut1: TMenuItem;
  90.     Copy1: TMenuItem;
  91.     CopytoFile1: TMenuItem;
  92.     Paste1: TMenuItem;
  93.     PastefromFile1: TMenuItem;
  94.     UUDecode1: TMenuItem;
  95.     MIMEDecode1: TMenuItem;
  96.     UUEncode1: TMenuItem;
  97.     MIMEEncode1: TMenuItem;
  98.     CheckMail1: TMenuItem;
  99.     ReplyToCurrentMessage1: TMenuItem;
  100.     SendCurrentMessage1: TMenuItem;
  101.     SendQueue1: TMenuItem;
  102.     Mailboxes1: TMenuItem;
  103.     Correspondents1: TMenuItem;
  104.     EmptyTrash1: TMenuItem;
  105.     SpeedButton4: TSpeedButton;
  106.     SpeedButton5: TSpeedButton;
  107.     SpeedButton3: TSpeedButton;
  108.     Panel8: TPanel;
  109.     Label1: TLabel;
  110.     Label2: TLabel;
  111.     ComboBox2: TComboBox;
  112.     Label3: TLabel;
  113.     ComboBox3: TComboBox;
  114.     ConnectToSite1: TMenuItem;
  115.     Disconnect1: TMenuItem;
  116.     UploadMarked1: TMenuItem;
  117.     DownloadMarked1: TMenuItem;
  118.     Directory1: TMenuItem;
  119.     ASCII1: TMenuItem;
  120.     Binary1: TMenuItem;
  121.     ASCII2: TMenuItem;
  122.     Binary2: TMenuItem;
  123.     ViewRemoteasText1: TMenuItem;
  124.     FTPSites1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     CreateNewMessage1: TMenuItem;
  128.     Article1: TMenuItem;
  129.     SubscribedNewsgroups1: TMenuItem;
  130.     Trash1: TMenuItem;
  131.     Preferences1: TMenuItem;
  132.     EMail3: TMenuItem;
  133.     FTP3: TMenuItem;
  134.     News2: TMenuItem;
  135.     Label4: TLabel;
  136.     Label5: TLabel;
  137.     ViewasText1: TMenuItem;
  138.     Change1: TMenuItem;
  139.     Create1: TMenuItem;
  140.     Delete3: TMenuItem;
  141.     ChangeLocal1: TMenuItem;
  142.     OpenDialog1: TOpenDialog;
  143.     SaveDialog1: TSaveDialog;
  144.     Paths1: TMenuItem;
  145.     ProgressInfo1: TMenuItem;
  146.     N2: TMenuItem;
  147.     ViewInEditWindow1: TMenuItem;
  148.     ViewInStatusLine1: TMenuItem;
  149.     SaveToFile1: TMenuItem;
  150.     ViewWinsockInfo1: TMenuItem;
  151.     Description1: TMenuItem;
  152.     SystemStatus1: TMenuItem;
  153.     VendorSpecific1: TMenuItem;
  154.     Gauge1: TGauge;
  155.     NewsServers1: TMenuItem;
  156.     AllReadArticles1: TMenuItem;
  157.     AllMarkedArticles1: TMenuItem;
  158.     AllAvailableArticles1: TMenuItem;
  159.     NewArticle1: TMenuItem;
  160.     FollowupArticle1: TMenuItem;
  161.     Post1: TMenuItem;
  162.     CurrentArticle1: TMenuItem;
  163.     EntireQueue1: TMenuItem;
  164.     ConnectandUpdate1: TMenuItem;
  165.     Disconnect2: TMenuItem;
  166.     Headers1: TMenuItem;
  167.     RetrieveMarked1: TMenuItem;
  168.     RetrieveAll1: TMenuItem;
  169.     DownloadActiveNewsgroups1: TMenuItem;
  170.     PutinQueue1: TMenuItem;
  171.     TrashMarkedMessages1: TMenuItem;
  172.     MailServers1: TMenuItem;
  173.     ExitEMailRequired1: TMenuItem;
  174.     ToCurrentMessage1: TMenuItem;
  175.     ToNewMessage1: TMenuItem;
  176.     ToFile2: TMenuItem;
  177.     AbortNewsgroupDownload1: TMenuItem;
  178.     Catchup1: TMenuItem;
  179.     Marked1: TMenuItem;
  180.     All1: TMenuItem;
  181.     File1: TMenuItem;
  182.     SelectedArticle1: TMenuItem;
  183.     SelectMultipleArticles1: TMenuItem;
  184.     DecodeSelections1: TMenuItem;
  185.     procedure Exit1Click(Sender: TObject);
  186.     procedure FormCreate(Sender: TObject);
  187.     procedure FormDestroy(Sender: TObject);
  188.     procedure Description1Click(Sender: TObject);
  189.     procedure SystemStatus1Click(Sender: TObject);
  190.     procedure VendorSpecific1Click(Sender: TObject);
  191.     procedure ViewInEditWindow1Click(Sender: TObject);
  192.     procedure ViewInStatusLine1Click(Sender: TObject);
  193.     procedure SaveToFile1Click(Sender: TObject);
  194.     procedure IPAddress1Click(Sender: TObject);
  195.     procedure FTP1Click(Sender: TObject);
  196.     procedure FormResize(Sender: TObject);
  197.     procedure FTPSites1Click(Sender: TObject);
  198.     procedure FTP3Click(Sender: TObject);
  199.     procedure ConnectToSite1Click(Sender: TObject);
  200.     procedure Button1Click(Sender: TObject);
  201.     procedure ViewasText1Click(Sender: TObject);
  202.     procedure Disconnect1Click(Sender: TObject);
  203.     procedure ToDisplay1Click(Sender: TObject);
  204.     procedure ToFile1Click(Sender: TObject);
  205.     procedure Binary2Click(Sender: TObject);
  206.     procedure Change1Click(Sender: TObject);
  207.     procedure ChangeLocal1Click(Sender: TObject);
  208.     procedure ListBox1DblClick(Sender: TObject);
  209.     procedure ListBox2DblClick(Sender: TObject);
  210.     procedure ASCII1Click(Sender: TObject);
  211.     procedure DeleteRemoteFiles1Click(Sender: TObject);
  212.     procedure Binary1Click(Sender: TObject);
  213.     procedure Delete3Click(Sender: TObject);
  214.     procedure Create1Click(Sender: TObject);
  215.     procedure ListBox1Click(Sender: TObject);
  216.     procedure UsenetNws1Click(Sender: TObject);
  217.     procedure Disconnect2Click(Sender: TObject);
  218.     procedure News2Click(Sender: TObject);
  219.     procedure ConnectandUpdate1Click(Sender: TObject);
  220.     procedure CheckNewNews1Click(Sender: TObject);
  221.     procedure NewsServers1Click(Sender: TObject);
  222.     procedure SubscribedNewsgroups1Click(Sender: TObject);
  223.     procedure AllReadArticles1Click(Sender: TObject);
  224.     procedure AllMarkedArticles1Click(Sender: TObject);
  225.     procedure AllAvailableArticles1Click(Sender: TObject);
  226.     procedure DownloadActiveNewsgroups1Click(Sender: TObject);
  227.     procedure Load1Click(Sender: TObject);
  228.     procedure Save1Click(Sender: TObject);
  229.     procedure Paths1Click(Sender: TObject);
  230.     procedure Cut1Click(Sender: TObject);
  231.     procedure Copy1Click(Sender: TObject);
  232.     procedure CopytoFile1Click(Sender: TObject);
  233.     procedure Paste1Click(Sender: TObject);
  234.     procedure PastefromFile1Click(Sender: TObject);
  235.     procedure SpeedButton5Click(Sender: TObject);
  236.     procedure SpeedButton1Click(Sender: TObject);
  237.     procedure SpeedButton2Click(Sender: TObject);
  238.     procedure ListBox2Click(Sender: TObject);
  239.     procedure AbortNewsgroupDownload1Click(Sender: TObject);
  240.     procedure Marked1Click(Sender: TObject);
  241.     procedure All1Click(Sender: TObject);
  242.   private
  243.     { Private declarations }
  244.   public
  245.     { Public declarations }
  246.     procedure EnableFTPMenus;
  247.     procedure DisableFTPMenus;
  248.     procedure EnableNNTPMenus;
  249.     procedure DisableNNTPMenus;
  250.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  251.     procedure UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  252.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  253.     function DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  254.     procedure DoFTPDisconnect;
  255.     procedure DoNNTPDisconnect;
  256.     procedure ReadIniData;
  257.     procedure WriteIniData;
  258.     procedure LoadFTPSiteFile;
  259.     procedure LoadNNTPSiteFile;
  260.     procedure SetupNNTPServersInfoDisplay;
  261.     procedure SaveFTPSiteFile;
  262.     procedure SetupFTPSiteLists;
  263.     procedure SaveNNTPSiteFile;
  264.     procedure SetupNNTPSiteLists;
  265.     procedure SetupNNTPNewsGroupsInfoDisplay;
  266.     procedure SetupNNTPNewsGroupLists;
  267.     procedure SaveNNTPNewsGroupLists;
  268.     procedure SetupNewsGroupListboxes;
  269.     procedure PopulateLB2WithArticleHeaders;
  270.     procedure AddNullTermTextToMemo( TheTextToAdd   : String;
  271.                                      TheMemoToAddTo : TMemo   );
  272.     function AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  273.     procedure SetHGCursors;
  274.     procedure SetNormalCursors;
  275.     procedure AddProgressText( WhatText : String );
  276.     procedure ShowProgressText( WhatText : String );
  277.     procedure ShowProgressErrorText( WhatText : String );
  278.     procedure SocketsErrorOccurred( Sender     : TObject;
  279.                                      ErrorCode  : Integer;
  280.                                      TheMessage : String   );
  281.   end;
  282.   { Component to hold FTP handling capabilities }
  283.   TFTPComponent = class( TWinControl )
  284.   public
  285.     FTPCommandInProgress ,
  286.     Connection_Established : Boolean;
  287.     Socket1 : TCCSocket;
  288.     Socket2 : TCCSocket;
  289.     constructor Create( AOwner : TComponent ); override;
  290.     destructor Destroy; override;
  291.     function GetTotalBytesToReceive( TheString : String ) : Longint;
  292.     function StripBrackets( TheString : String ) : String;
  293.     function GetShortPathname( TheString : String ) : String;
  294.     function GetWin16FileName( InputName : String ) : String;
  295.     function GetRemoteWorkingDirectory( var RemoteDir : String ) : Boolean;
  296.     function SetRemoteDirectory( TheDir : String ) : Boolean;
  297.     function DeleteRemoteDirectory( TheDir : String ) : Boolean;
  298.     function CreateRemoteDirectory( TheDir : String ) : Boolean;
  299.     function DeleteRemoteFile( TheFileName : String ) : Boolean;
  300.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  301.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  302.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  303.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  304.               : Boolean;
  305.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  306.     function GetRemoteDirectoryListingToMemo : Boolean;
  307.     procedure SendASCIILocalFile( LocalName : String );
  308.     procedure SendBinaryLocalFile( LocalName : String );
  309.     procedure ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  310.     procedure ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  311.     function GetLocalDirectoryAndListing( var TheString : String;
  312.                                               TheListBox : TListBox )
  313.               : Boolean;
  314.     function GetUNIXTextString( var StringIn : String ) : String;
  315.     procedure ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  316.     function GetListeningPort : Integer;
  317.     procedure GetFileNameFromUNIXFileName( var TheName : String );
  318.     function Disconnect : Boolean;
  319.     function DoCStyleFormat(       TheText      : string;
  320.                              const TheArguments : array of const ) : String;
  321.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  322.     function GetQuotedString( TheString : String ) : String;
  323.     procedure AddProgressText( WhatText : String );
  324.     procedure ShowProgressText( WhatText : String );
  325.     procedure ShowProgressErrorText( WhatText : String );
  326.     function GetFTPServerResponse( var ResponseString : String ) : integer;
  327.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  328.                                      ErrorCode  : Integer;
  329.                                      TheMessage : String   );
  330.     function PerformFTPCommand(
  331.                     TheCommand   : string;
  332.               const TheArguments : array of const ) : Integer;
  333.   end;
  334. const
  335.   POV_MEMO                 = 1; { Progress to the Memo           }
  336.   POV_STAT                 = 2; { Progress to the status caption }
  337.   TCPIP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  338.   TCPIP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  339.   TCPIP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  340.   TCPIP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  341.   TCPIP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  342.  
  343. var
  344.   CCINetCCForm         : TCCINetCCForm;
  345.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  346.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  347.   ProgressList         : TStringList;    { Used to hold progress text info }
  348.   ProgressFileName     : String;         { Used to hold progress file name }
  349.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  350.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  351.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  352.   TheNewsServerList    : TList;          { Used to hold list of NNTP servs }
  353.   TheWorkingNSSL       : TList;          { Used for working copy of above  }
  354.   TheEMailServerList   : TList;          { Used for list of POP3/SMTP serv }
  355.   TheWorkingEMSL       : TList;          { Used for working copy of above  }
  356.   TheNewsRCList        : TList;          { Used for list of available ngs  }
  357.   TheWorkingNRCSL      : TList;          { Used for working copy of above  }
  358.   TheNGArticlesList    : TList;          { Used for current articles list  }
  359.                                          { (will hot swap from pointer of  }
  360.                                          {  Tlist of Tlists in base rec.)  }
  361.   TheNewsServerFile    : CRFile;         { File of NNTP servers records    }
  362.   TheNewsRCFile        : NGRFile;        { File of Newsgroups records      }
  363.   TheNewsArticleFile   : NGARFile;       { Current ng articles records file}
  364.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  365.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  366.   MailPath             : String;         { Used for path to Mail Files     }
  367.   NewsPath             : String;         { Used for path to News Files     }
  368.   FTPPath              : String;         { Used for path to FTP Files      }
  369.   CurrentPassWordString : String;        { Used to hold login id for anons }
  370.   CurrentEMPassWordString : String;      { Used to hold login id for anons }
  371.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  372.   CurrentRealPWString   : String;        { Used to hold a real password    }
  373.   EMPassWordControlVector : Integer;       { Used to hold display of pw vect }
  374.   CurrentEMRealPWString   : String;        { Used to hold a real password    }
  375.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  376.   TheLine ,
  377.   HolderLine ,
  378.   GlobalTextBuffer      : String;
  379.   TheAnonRedialVector ,
  380.   DefaultDownloadVector : Integer;
  381.   NewsReadArticlePurgingVector : Integer;
  382.   NewsPostQueueingVector : Integer;
  383.   NewsReadArticleDisplayVector : Integer;
  384.   NewsUUMIMEVector : Integer;
  385.   NewsInitialUpdateVector : Integer;
  386.   LeftoverText          : String;
  387.   LeftoversOnTable      : Boolean;
  388.   FileNameToXFer        : String;
  389.   WhichServer           : Integer;       { Holds current NNTP server }
  390.   WhichGroup            : Integer;       { Holds current NNTP newsgroup }
  391.   EMRemoteDeletionVector : Integer;
  392.   EMChokeVector : Integer;
  393.   EMDefaultDownloadVector : Integer;
  394.   EMQueueVector : Integer;
  395.   NewsgroupListLoaded ,
  396.   EmailLoaded ,
  397.   NewMessageInProgress : Boolean;
  398.   TheUUDecodeList      : TStringList;
  399.   
  400. implementation
  401.  
  402. uses CCICNNTP;
  403.  
  404. var
  405.   TheNNTPComponent      : TNNTPComponent;{ NNTP News Object                }
  406.  
  407. {$R *.DFM}
  408.  
  409.  
  410.  
  411. { This is the FTP component constructor; it creates 2 sockets }
  412. constructor TFTPComponent.Create( AOwner : TComponent );
  413. begin
  414.   { do inherited create }
  415.   inherited Create( AOwner );
  416.   { Create sockets, put in their parents, and error procs }
  417.   Socket1 := TCCSocket.Create( Self );
  418.   Socket1.Parent := Self;
  419.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  420.   Socket2 := TCCSocket.Create( Self );
  421.   Socket2.Parent := Self;
  422.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  423.   { Set up booleans }
  424.   Connection_Established := false;
  425.   FTPCommandInProgress := false;
  426. end;
  427.  
  428. { This is the FTP component destructor; it frees 2 sockets }
  429. destructor TFTPComponent.Destroy;
  430. begin
  431.   { Free the sockets }
  432.   Socket1.Free;
  433.   Socket2.Free;
  434.   { and call inherited }
  435.   inherited Destroy;
  436. end;
  437.  
  438. function TFTPComponent.GetShortPathname( TheString : String ) : String;
  439. var HoldingString : String;
  440. begin
  441.   HoldingString := Copy( TheString , 1 , 3 );
  442.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  443.   Result := HoldingString;
  444. end;
  445.  
  446. function TFTPComponent.StripBrackets( TheString : String ) : String;
  447. var HoldingString : String;
  448.     HoldingPosition : Integer;
  449. begin
  450.   HoldingPosition := Pos( '[' , TheString );
  451.   if HoldingPosition = 0 then
  452.   begin
  453.     Result := TheString;
  454.     exit;
  455.   end
  456.   else
  457.   begin
  458.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  459.     HoldingPosition := Pos( ']' , HoldingString );
  460.     if HoldingPosition = 0 then
  461.     begin
  462.       Result := HoldingString;
  463.       exit;
  464.     end
  465.     else
  466.     begin
  467.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  468.       Result := HoldingString;
  469.       exit;
  470.     end;
  471.   end;
  472. end;
  473.  
  474. { This function takes a UNIX filespec and turns it into a Win16 filename }
  475. function TFTPComponent.GetWin16FileName( InputName : String ) : String;
  476. var WorkingString ,
  477.     HoldingString   : String; { Holding string }
  478. begin
  479.   WorkingString := ExtractFileExt( InputName );
  480.   if WorkingString = '' then
  481.   begin
  482.     if Length( InputName ) > 8 then
  483.      WorkingString := Copy( InputName , 1 , 8 ) else
  484.       WorkingString := InputName;
  485.   end
  486.   else
  487.   begin
  488.     if Length( WorkingString ) > 4 then
  489.      WorkingString := Copy( WorkingString , 1 , 4 );
  490.     HoldingString :=
  491.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  492.     if Length( HoldingString ) > 8 then
  493.      HoldingString := Copy( HoldingString , 1 , 8 );
  494.     if HoldingString = '' then
  495.     begin
  496.       { Dot file }
  497.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  498.       WorkingString := HoldingString;
  499.     end
  500.     else WorkingString := HoldingString + WorkingString;
  501.   end;
  502.   Result := WorkingString;
  503. end;
  504.  
  505. { This sends a local file in binary mode to the remote server }
  506. procedure TFTPComponent.SendBinaryLocalFile( LocalName : String );
  507. var TheReturnString : String;  { Internal string holder }
  508.     TheResult       : Integer; { Internal int holder    }
  509.     Through         : Boolean;
  510.     FileNamePChar   : array[ 0 .. 255 ] of char;
  511.     OutputFileHandle : Integer;
  512.     TotalBytesSent ,
  513.     BytesRead ,
  514.     FileToSendSize    : Longint;
  515.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  516. begin
  517.   LocalName := ExpandFileName( LocalName );
  518.   StrPCopy( FileNamePChar , LocalName );
  519.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  520.   if OutputFileHandle = -1 then
  521.   begin
  522.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  523.      mtError , [mbOK] , 0 );
  524.     exit;
  525.   end;
  526.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  527.   _llseek( OutputFileHandle , 0 , 0 );
  528.   TheReturnString :=
  529.    DoCStyleFormat( 'TYPE I' ,
  530.     [ nil ] );
  531.   { Put result in progress and status line }
  532.   AddProgressText( TheReturnString );
  533.   ShowProgressText( TheReturnString );
  534.   { Send Password sequence }
  535.   TheResult := PerformFTPCommand( 'TYPE I',
  536.                                   [ nil ] );
  537.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  538.   begin
  539.     FTPCommandInProgress := false;
  540.     exit;
  541.   end;
  542.   repeat
  543.     TheResult := GetFTPServerResponse( TheReturnString );
  544.     { Put result in progress and status line }
  545.     AddProgressText( TheReturnString );
  546.     ShowProgressText( TheReturnString );
  547.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  548.   FTPCommandInProgress := false;
  549.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  550.   begin
  551.     { Do clever C formatting trick }
  552.     TheReturnString :=
  553.      DoCStyleFormat( 'FTP File Send Failed!' ,
  554.       [ nil ] );
  555.     { Put result in progress and status line }
  556.     AddProgressText( TheReturnString );
  557.     ShowProgressErrorText( TheReturnString );
  558.     { leave }
  559.     exit;
  560.   end
  561.   else
  562.   begin
  563.     { Set up socket 2 for listening }
  564.     Socket2.AsynchMode := False;
  565.     Socket2.NonAsynchTimeoutValue := 60;
  566.     { do a listen and send command to server that this is receipt socket }
  567.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  568.     begin
  569.       Socket2.CCSockCancelListen;
  570.       exit;
  571.     end;
  572.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  573.     TheReturnString :=
  574.      DoCStyleFormat( 'STOR %s' ,
  575.       [ ExtractFileName( LocalName ) ] );
  576.     { Put result in progress and status line }
  577.     AddProgressText( TheReturnString );
  578.     ShowProgressText( TheReturnString );
  579.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName ) ] );
  580.     GetFTPServerResponse( TheReturnString );
  581.     AddProgressText( TheReturnString );
  582.     ShowProgressText( TheReturnString );
  583.     Socket1.NonAsynchTimeoutValue := 30;
  584.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  585.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  586.     begin
  587.       TheReturnString :=
  588.        DoCStyleFormat( 'Could not create remote file!' ,
  589.         [ nil ] );
  590.       { Put result in progress and status line }
  591.       AddProgressText( TheReturnString );
  592.       ShowProgressErrorText( TheReturnString );
  593.       Socket2.CCSockCancelListen;
  594.       exit;
  595.     end;
  596.     Socket2.CCSockAccept;
  597.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  598.     begin
  599.       TheReturnString :=
  600.        DoCStyleFormat( 'Could not establish send socket!' ,
  601.         [ nil ] );
  602.       { Put result in progress and status line }
  603.       AddProgressText( TheReturnString );
  604.       ShowProgressErrorText( TheReturnString );
  605.       exit;
  606.     end;
  607.     Through := false;
  608.     TotalBytesSent := 0;
  609.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  610.     repeat
  611.       if BytesRead = 0 then Through := true;
  612.       if BytesRead > 0 then
  613.       begin
  614.         CopyBuffer[ 0 ] := Chr( BytesRead );
  615.         Socket2.StringData := TheReturnString;
  616.         TotalBytesSent := TotalBytesSent + BytesRead;
  617.         UpdateGauge( TotalBytesSent , FileToSendSize );
  618.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  619.         if BytesRead = -1 then
  620.         begin
  621.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  622.           GlobalAbortedFlag := True;
  623.         end;
  624.       end;
  625.       if GlobalAbortedFlag then
  626.       begin
  627.         Socket1.OutOfBand := 'ABOR'+#13#10;
  628.         repeat
  629.           TheResult := GetFTPServerResponse( TheReturnString );
  630.           { Put result in progress and status line }
  631.           AddProgressText( TheReturnString );
  632.           ShowProgressText( TheReturnString );
  633.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  634.         exit;
  635.       end;
  636.     until Through;
  637.     FTPCommandInProgress := false;
  638.     { cancel listening on second socket and close it }
  639.     Socket2.CCSockCancelListen;
  640.     Socket2.CCSockClose;
  641.     TheReturnString := 'Transfer Succeeded' + #13#10;
  642.     AddProgressText( TheReturnString );
  643.     ShowProgressText( TheReturnString );
  644.     FTPCommandInProgress := false;
  645.     PerformFTPCommand( 'TYPE A',
  646.                                     [ nil ] );
  647.     Through := false;
  648.     repeat
  649.       GetFTPServerResponse( TheReturnString );
  650.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  651.        Through := true;
  652.       { Put result in progress and status line }
  653.       AddProgressText( TheReturnString );
  654.       ShowProgressText( TheReturnString );
  655.     until (( GlobalAbortedFlag ) or Through );
  656.   end;
  657.   _lclose( OutputFileHandle );
  658.   FTPCommandInProgress := false;
  659. end;
  660.  
  661. { This sends a local file in ascii mode to remote server }
  662. procedure TFTPComponent.SendASCIILocalFile( LocalName : String );
  663. var TheReturnString : String;  { Internal string holder }
  664.     TheResult       : Integer; { Internal int holder    }
  665.     Through         : Boolean;
  666.     FileNamePChar   : array[ 0 .. 255 ] of char;
  667.     OutputFileHandle : Integer;
  668.     TotalBytesSent ,
  669.     BytesRead ,
  670.     FileToSendSize    : Longint;
  671.     CopyBuffer       : array[ 0 .. 255 ] of char absolute TheReturnString;
  672. begin
  673.   LocalName := ExpandFileName( LocalName );
  674.   StrPCopy( FileNamePChar , LocalName );
  675.   OutputFileHandle := _lopen( FileNamePChar , 0 );
  676.   if OutputFileHandle = -1 then
  677.   begin
  678.     MessageDlg( 'Cannot Open local file ' + LocalName ,
  679.      mtError , [mbOK] , 0 );
  680.     exit;
  681.   end;
  682.   FileToSendSize := _llseek( OutputFileHandle , 0 , 2 );
  683.   _llseek( OutputFileHandle , 0 , 0 );
  684.   TheReturnString :=
  685.    DoCStyleFormat( 'TYPE A' ,
  686.     [ nil ] );
  687.   { Put result in progress and status line }
  688.   AddProgressText( TheReturnString );
  689.   ShowProgressText( TheReturnString );
  690.   { Send Password sequence }
  691.   TheResult := PerformFTPCommand( 'TYPE A',
  692.                                   [ nil ] );
  693.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  694.   begin
  695.     FTPCommandInProgress := false;
  696.     exit;
  697.   end;
  698.   repeat
  699.     TheResult := GetFTPServerResponse( TheReturnString );
  700.     { Put result in progress and status line }
  701.     AddProgressText( TheReturnString );
  702.     ShowProgressText( TheReturnString );
  703.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  704.   FTPCommandInProgress := false;
  705.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  706.   begin
  707.     { Do clever C formatting trick }
  708.     TheReturnString :=
  709.      DoCStyleFormat( 'FTP File Send Failed!' ,
  710.       [ nil ] );
  711.     { Put result in progress and status line }
  712.     AddProgressText( TheReturnString );
  713.     ShowProgressErrorText( TheReturnString );
  714.     { leave }
  715.     exit;
  716.   end
  717.   else
  718.   begin
  719.     { Set up socket 2 for listening }
  720.     Socket2.AsynchMode := False;
  721.     Socket2.NonAsynchTimeoutValue := 60;
  722.     { do a listen and send command to server that this is receipt socket }
  723.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  724.     begin
  725.       Socket2.CCSockCancelListen;
  726.       exit;
  727.     end;
  728.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  729.     TheReturnString :=
  730.      DoCStyleFormat( 'STOR %s' ,
  731.       [ ExtractFileName( LocalName ) ] );
  732.     { Put result in progress and status line }
  733.     AddProgressText( TheReturnString );
  734.     ShowProgressText( TheReturnString );
  735.     TheResult := PerformFTPCommand( 'STOR %s' , [ ExtractFileName( LocalName )]);
  736.     GetFTPServerResponse( TheReturnString );
  737.     AddProgressText( TheReturnString );
  738.     ShowProgressText( TheReturnString );
  739.     Socket1.NonAsynchTimeoutValue := 30;
  740.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  741.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  742.     begin
  743.       TheReturnString :=
  744.        DoCStyleFormat( 'Could not create remote file!' ,
  745.         [ nil ] );
  746.       { Put result in progress and status line }
  747.       AddProgressText( TheReturnString );
  748.       ShowProgressErrorText( TheReturnString );
  749.       Socket2.CCSockCancelListen;
  750.       exit;
  751.     end;
  752.     Socket2.CCSockAccept;
  753.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  754.     begin
  755.       TheReturnString :=
  756.        DoCStyleFormat( 'Could not establish send socket!' ,
  757.         [ nil ] );
  758.       { Put result in progress and status line }
  759.       AddProgressText( TheReturnString );
  760.       ShowProgressErrorText( TheReturnString );
  761.       exit;
  762.     end;
  763.     Through := false;
  764.     TotalBytesSent := 0;
  765.     BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  766.     repeat
  767.       if BytesRead = 0 then Through := true;
  768.       if BytesRead > 0 then
  769.       begin
  770.         CopyBuffer[ 0 ] := Chr( BytesRead );
  771.         Socket2.StringData := TheReturnString;
  772.         TotalBytesSent := TotalBytesSent + BytesRead;
  773.         UpdateGauge( TotalBytesSent , FileToSendSize );
  774.         BytesRead := _lread( OutputFileHandle , @CopyBuffer[ 1 ] , 255 );
  775.         if BytesRead = -1 then
  776.         begin
  777.           MessageDlg( 'File Read Error on ' + LocalName , mtError , [mbOK] , 0 );
  778.           GlobalAbortedFlag := True;
  779.         end;
  780.       end;
  781.       if GlobalAbortedFlag then
  782.       begin
  783.         Socket1.OutOfBand := 'ABOR'+#13#10;
  784.         repeat
  785.           TheResult := GetFTPServerResponse( TheReturnString );
  786.           { Put result in progress and status line }
  787.           AddProgressText( TheReturnString );
  788.           ShowProgressText( TheReturnString );
  789.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  790.         exit;
  791.       end;
  792.     until Through;
  793.     { cancel listening on second socket and close it }
  794.     Socket2.CCSockCancelListen;
  795.     Socket2.CCSockClose;
  796.     TheReturnString := 'Transfer Succeeded' + #13#10;
  797.     AddProgressText( TheReturnString );
  798.     ShowProgressText( TheReturnString );
  799.     FTPCommandInProgress := false;
  800.     PerformFTPCommand( 'TYPE A', [ nil ] );
  801.     Through := false;
  802.     repeat
  803.       GetFTPServerResponse( TheReturnString );
  804.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  805.        Through := true;
  806.       { Put result in progress and status line }
  807.       AddProgressText( TheReturnString );
  808.       ShowProgressText( TheReturnString );
  809.     until (( GlobalAbortedFlag ) or Through );
  810.   end;
  811.   _lclose( OutputFileHandle );
  812.   FTPCommandInProgress := false;
  813. end;
  814.  
  815. { This function strips out the FTP response for bytes to send }
  816. function TFTPComponent.GetTotalBytesToReceive( TheString : String ) : Longint;
  817. var
  818.   LeftPosition ,
  819.   RightPosition  : integer;
  820.   TempString     : string;
  821. begin
  822.   LeftPosition := Pos( '(' , TheString );
  823.   TempString := Copy( TheString ,
  824.                       LeftPosition + 1 , 255 );
  825.   RightPosition := Pos( ' ' , TempString );
  826.   if (( LeftPosition = 0 ) or ( RightPosition = 0 )) then
  827.   begin
  828.     Result := 0;
  829.     exit;
  830.   end;
  831.   if RightPosition <> 0 then
  832.     TempString := Copy( TempString , 1 , RightPosition - 1  );
  833.   try
  834.     Result := StrToInt( TempString );
  835.   except
  836.     on EConvertError do Result := 0;
  837.   end;
  838. end;
  839.  
  840. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  841. begin
  842.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  843. end;
  844.  
  845. { This sends FTP progress text to the Inet form }
  846. procedure TFTPComponent.AddProgressText( WhatText : String );
  847. begin
  848.   CCInetCCForm.AddProgressText( WhatText );
  849. end;
  850.  
  851. { This sends FTP progress text to the Inet form }
  852. procedure TFTPComponent.ShowProgressText( WhatText : String );
  853. begin
  854.   CCInetCCForm.ShowProgressText( WhatText );
  855. end;
  856.  
  857. { This procedure receives a binary remote file }
  858. procedure TFTPComponent.ReceiveASCIIRemoteFileToMemo( RemoteName : String );
  859. var TheReturnString : String;  { Internal string holder }
  860.     TheResult       : Integer; { Internal int holder    }
  861.     Through         : Boolean;
  862.     TotalBytesSent ,
  863.     FileToGetSize    : Longint;
  864. begin
  865.   TheReturnString :=
  866.    DoCStyleFormat( 'TYPE A' ,
  867.     [ nil ] );
  868.   { Put result in progress and status line }
  869.   AddProgressText( TheReturnString );
  870.   ShowProgressText( TheReturnString );
  871.   { Send Password sequence }
  872.   FTPCommandInProgress := false;
  873.   TheResult := PerformFTPCommand( 'TYPE A',
  874.                                   [ nil ] );
  875.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  876.   begin
  877.     FTPCommandInProgress := false;
  878.     exit;
  879.   end;
  880.   repeat
  881.     TheResult := GetFTPServerResponse( TheReturnString );
  882.     { Put result in progress and status line }
  883.     AddProgressText( TheReturnString );
  884.     ShowProgressText( TheReturnString );
  885.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  886.   FTPCommandInProgress := false;
  887.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  888.   begin
  889.     { Do clever C formatting trick }
  890.     TheReturnString :=
  891.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  892.       [ nil ] );
  893.     { Put result in progress and status line }
  894.     AddProgressText( TheReturnString );
  895.     ShowProgressErrorText( TheReturnString );
  896.     { leave }
  897.     exit;
  898.   end
  899.   else
  900.   begin
  901.     { Set up socket 2 for listening }
  902.     Socket2.AsynchMode := False;
  903.     Socket2.NonAsynchTimeoutValue := 60;
  904.     { do a listen and send command to server that this is receipt socket }
  905.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  906.     begin
  907.       Socket2.CCSockCancelListen;
  908.       exit;
  909.     end;
  910.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  911.     TheReturnString :=
  912.      DoCStyleFormat( 'RETR %s' ,
  913.       [ RemoteName ] );
  914.     { Put result in progress and status line }
  915.     AddProgressText( TheReturnString );
  916.     ShowProgressText( TheReturnString );
  917.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  918.     GetFTPServerResponse( TheReturnString );
  919.     AddProgressText( TheReturnString );
  920.     ShowProgressText( TheReturnString );
  921.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  922.     Socket1.NonAsynchTimeoutValue := 30;
  923.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  924.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  925.     begin
  926.       TheReturnString :=
  927.        DoCStyleFormat( 'Could not obtain remote file!' ,
  928.         [ nil ] );
  929.       { Put result in progress and status line }
  930.       AddProgressText( TheReturnString );
  931.       ShowProgressErrorText( TheReturnString );
  932.       Socket2.CCSockCancelListen;
  933.       exit;
  934.     end;
  935.     Socket2.CCSockAccept;
  936.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  937.     begin
  938.       TheReturnString :=
  939.        DoCStyleFormat( 'Could not establish receive socket!' ,
  940.         [ nil ] );
  941.       { Put result in progress and status line }
  942.       AddProgressText( TheReturnString );
  943.       ShowProgressErrorText( TheReturnString );
  944.       exit;
  945.     end;
  946.     Through := false;
  947.     TotalBytesSent := 0;
  948.     repeat
  949.       TheReturnString := Socket2.StringData;
  950.       if Length( TheReturnString ) = 0 then Through := true;
  951.       if Length( TheReturnString ) > 0 then
  952.       begin
  953.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  954.         UpdateGauge( TotalBytesSent , FileToGetSize );
  955.         { Put result in progress and status line }
  956.         AddProgressText( TheReturnString );
  957.         ShowProgressText( TheReturnString );
  958.       end;
  959.       if GlobalAbortedFlag then
  960.       begin
  961.         Socket1.OutOfBand := 'ABOR'+#13#10;
  962.         repeat
  963.           TheResult := GetFTPServerResponse( TheReturnString );
  964.           { Put result in progress and status line }
  965.           AddProgressText( TheReturnString );
  966.           ShowProgressText( TheReturnString );
  967.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  968.         exit;
  969.       end;
  970.     until Through;
  971.     { cancel listening on second socket and close it }
  972.     Socket2.CCSockCancelListen;
  973.     Socket2.CCSockClose;
  974.     FTPCommandInProgress := false;
  975.     PerformFTPCommand( 'TYPE A', [ nil ] );
  976.     Through := false;
  977.     repeat
  978.       GetFTPServerResponse( TheReturnString );
  979.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  980.        Through := true;
  981.       { Put result in progress and status line }
  982.       AddProgressText( TheReturnString );
  983.       ShowProgressText( TheReturnString );
  984.     until (( GlobalAbortedFlag ) or Through );
  985.   end;
  986.   FTPCommandInProgress := false;
  987. end;
  988.  
  989. { This procedure receives a binary remote file }
  990. procedure TFTPComponent.ReceiveASCIIRemoteFile( RemoteName , LocalName : String );
  991. var TheReturnString : String;  { Internal string holder }
  992.     TheResult       : Integer; { Internal int holder    }
  993.     Through         : Boolean;
  994.     FileNamePChar   : array[ 0 .. 255 ] of char;
  995.     OutputFileHandle : Integer;
  996.     TotalBytesSent ,
  997.     FileToGetSize    : Longint;
  998.     CopyBuffer       : array[ 0 .. 255 ] of char;
  999. begin
  1000.   LocalName := ExpandFileName( LocalName );
  1001.   StrPCopy( FileNamePChar , LocalName );
  1002.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1003.   if OutputFileHandle = -1 then
  1004.   begin
  1005.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1006.      mtError , [mbOK] , 0 );
  1007.     exit;
  1008.   end;
  1009.   TheReturnString :=
  1010.    DoCStyleFormat( 'TYPE A' ,
  1011.     [ nil ] );
  1012.   { Put result in progress and status line }
  1013.   AddProgressText( TheReturnString );
  1014.   ShowProgressText( TheReturnString );
  1015.   { Send Password sequence }
  1016.   TheResult := PerformFTPCommand( 'TYPE A',
  1017.                                   [ nil ] );
  1018.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1019.   begin
  1020.     FTPCommandInProgress := false;
  1021.     exit;
  1022.   end;
  1023.   repeat
  1024.     TheResult := GetFTPServerResponse( TheReturnString );
  1025.     { Put result in progress and status line }
  1026.     AddProgressText( TheReturnString );
  1027.     ShowProgressText( TheReturnString );
  1028.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1029.   FTPCommandInProgress := false;
  1030.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1031.   begin
  1032.     { Do clever C formatting trick }
  1033.     TheReturnString :=
  1034.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1035.       [ nil ] );
  1036.     { Put result in progress and status line }
  1037.     AddProgressText( TheReturnString );
  1038.     ShowProgressErrorText( TheReturnString );
  1039.     { leave }
  1040.     exit;
  1041.   end
  1042.   else
  1043.   begin
  1044.     { Set up socket 2 for listening }
  1045.     Socket2.AsynchMode := False;
  1046.     Socket2.NonAsynchTimeoutValue := 60;
  1047.     { do a listen and send command to server that this is receipt socket }
  1048.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1049.     begin
  1050.       Socket2.CCSockCancelListen;
  1051.       exit;
  1052.     end;
  1053.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1054.     TheReturnString :=
  1055.      DoCStyleFormat( 'RETR %s' ,
  1056.       [ RemoteName ] );
  1057.     { Put result in progress and status line }
  1058.     AddProgressText( TheReturnString );
  1059.     ShowProgressText( TheReturnString );
  1060.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1061.     GetFTPServerResponse( TheReturnString );
  1062.     AddProgressText( TheReturnString );
  1063.     ShowProgressText( TheReturnString );
  1064.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1065.     Socket1.NonAsynchTimeoutValue := 30;
  1066.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1067.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1068.     begin
  1069.       TheReturnString :=
  1070.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1071.         [ nil ] );
  1072.       { Put result in progress and status line }
  1073.       AddProgressText( TheReturnString );
  1074.       ShowProgressErrorText( TheReturnString );
  1075.       Socket2.CCSockCancelListen;
  1076.       exit;
  1077.     end;
  1078.     Socket2.CCSockAccept;
  1079.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1080.     begin
  1081.       TheReturnString :=
  1082.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1083.         [ nil ] );
  1084.       { Put result in progress and status line }
  1085.       AddProgressText( TheReturnString );
  1086.       ShowProgressErrorText( TheReturnString );
  1087.       exit;
  1088.     end;
  1089.     Through := false;
  1090.     TotalBytesSent := 0;
  1091.     repeat
  1092.       TheReturnString := Socket2.StringData;
  1093.       if Length( TheReturnString ) = 0 then Through := true;
  1094.       if Length( TheReturnString ) > 0 then
  1095.       begin
  1096.         StrPCopy( CopyBuffer , TheReturnString );
  1097.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1098.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1099.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1100.          = -1 then
  1101.         begin
  1102.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1103.           GlobalAbortedFlag := True;
  1104.         end;
  1105.       end;
  1106.       if GlobalAbortedFlag then
  1107.       begin
  1108.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1109.         repeat
  1110.           TheResult := GetFTPServerResponse( TheReturnString );
  1111.           { Put result in progress and status line }
  1112.           AddProgressText( TheReturnString );
  1113.           ShowProgressText( TheReturnString );
  1114.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1115.         exit;
  1116.       end;
  1117.     until Through;
  1118.     { cancel listening on second socket and close it }
  1119.     Socket2.CCSockCancelListen;
  1120.     Socket2.CCSockClose;
  1121.     FTPCommandInProgress := false;
  1122.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1123.     Through := false;
  1124.     repeat
  1125.       GetFTPServerResponse( TheReturnString );
  1126.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1127.        Through := true;
  1128.       { Put result in progress and status line }
  1129.       AddProgressText( TheReturnString );
  1130.       ShowProgressText( TheReturnString );
  1131.     until (( GlobalAbortedFlag ) or Through );
  1132.   end;
  1133.   _lclose( OutputFileHandle );
  1134.   FTPCommandInProgress := false;
  1135. end;
  1136.  
  1137. { This procedure receives a binary remote file }
  1138. procedure TFTPComponent.ReceiveBinaryRemoteFile( RemoteName , LocalName : String );
  1139. var TheReturnString : String;  { Internal string holder }
  1140.     TheResult       : Integer; { Internal int holder    }
  1141.     Through         : Boolean;
  1142.     FileNamePChar   : array[ 0 .. 255 ] of char;
  1143.     OutputFileHandle : Integer;
  1144.     TotalBytesSent ,
  1145.     FileToGetSize    : Longint;
  1146.     CopyBuffer       : array[ 0 .. 255 ] of char;
  1147. begin
  1148.   LocalName := ExpandFileName( LocalName );
  1149.   StrPCopy( FileNamePChar , LocalName );
  1150.   OutputFileHandle := _lcreat( FileNamePChar , 0 );
  1151.   if OutputFileHandle = -1 then
  1152.   begin
  1153.     MessageDlg( 'Cannot Create local file ' + LocalName ,
  1154.      mtError , [mbOK] , 0 );
  1155.     exit;
  1156.   end;
  1157.   TheReturnString :=
  1158.    DoCStyleFormat( 'TYPE I' ,
  1159.     [ nil ] );
  1160.   { Put result in progress and status line }
  1161.   AddProgressText( TheReturnString );
  1162.   ShowProgressText( TheReturnString );
  1163.   { Send Password sequence }
  1164.   TheResult := PerformFTPCommand( 'TYPE I',
  1165.                                   [ nil ] );
  1166.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1167.   begin
  1168.     FTPCommandInProgress := false;
  1169.     exit;
  1170.   end;
  1171.   repeat
  1172.     TheResult := GetFTPServerResponse( TheReturnString );
  1173.     { Put result in progress and status line }
  1174.     AddProgressText( TheReturnString );
  1175.     ShowProgressText( TheReturnString );
  1176.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1177.   FTPCommandInProgress := false;
  1178.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1179.   begin
  1180.     { Do clever C formatting trick }
  1181.     TheReturnString :=
  1182.      DoCStyleFormat( 'FTP File Receive Failed!' ,
  1183.       [ nil ] );
  1184.     { Put result in progress and status line }
  1185.     AddProgressText( TheReturnString );
  1186.     ShowProgressErrorText( TheReturnString );
  1187.     { leave }
  1188.     exit;
  1189.   end
  1190.   else
  1191.   begin
  1192.     { Set up socket 2 for listening }
  1193.     Socket2.AsynchMode := False;
  1194.     Socket2.NonAsynchTimeoutValue := 60;
  1195.     { do a listen and send command to server that this is receipt socket }
  1196.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  1197.     begin
  1198.       Socket2.CCSockCancelListen;
  1199.       exit;
  1200.     end;
  1201.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1202.     TheReturnString :=
  1203.      DoCStyleFormat( 'RETR %s' ,
  1204.       [ RemoteName ] );
  1205.     { Put result in progress and status line }
  1206.     AddProgressText( TheReturnString );
  1207.     ShowProgressText( TheReturnString );
  1208.     TheResult := PerformFTPCommand( 'RETR %s' , [RemoteName] );
  1209.     GetFTPServerResponse( TheReturnString );
  1210.     AddProgressText( TheReturnString );
  1211.     ShowProgressText( TheReturnString );
  1212.     FileToGetSize := GetTotalBytesToReceive( TheReturnString );
  1213.     Socket1.NonAsynchTimeoutValue := 30;
  1214.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  1215.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  1216.     begin
  1217.       TheReturnString :=
  1218.        DoCStyleFormat( 'Could not obtain remote file!' ,
  1219.         [ nil ] );
  1220.       { Put result in progress and status line }
  1221.       AddProgressText( TheReturnString );
  1222.       ShowProgressErrorText( TheReturnString );
  1223.       Socket2.CCSockCancelListen;
  1224.       exit;
  1225.     end;
  1226.     Socket2.CCSockAccept;
  1227.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1228.     begin
  1229.       TheReturnString :=
  1230.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1231.         [ nil ] );
  1232.       { Put result in progress and status line }
  1233.       AddProgressText( TheReturnString );
  1234.       ShowProgressErrorText( TheReturnString );
  1235.       exit;
  1236.     end;
  1237.     Through := false;
  1238.     TotalBytesSent := 0;
  1239.     repeat
  1240.       TheReturnString := Socket2.StringData;
  1241.       if Length( TheReturnString ) = 0 then Through := true;
  1242.       if Length( TheReturnString ) > 0 then
  1243.       begin
  1244.         StrPCopy( CopyBuffer , TheReturnString );
  1245.         TotalBytesSent := TotalBytesSent + Length( TheReturnString );
  1246.         UpdateGauge( TotalBytesSent , FileToGetSize );
  1247.         if _lwrite( OutputFileHandle , CopyBuffer , Length( TheReturnString ))
  1248.          = -1 then
  1249.         begin
  1250.           MessageDlg( 'File Write Error on ' + LocalName , mtError , [mbOK] , 0 );
  1251.           GlobalAbortedFlag := True;
  1252.         end;
  1253.       end;
  1254.       if GlobalAbortedFlag then
  1255.       begin
  1256.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1257.         repeat
  1258.           TheResult := GetFTPServerResponse( TheReturnString );
  1259.           { Put result in progress and status line }
  1260.           AddProgressText( TheReturnString );
  1261.           ShowProgressText( TheReturnString );
  1262.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1263.         exit;
  1264.       end;
  1265.     until Through;
  1266.     { cancel listening on second socket and close it }
  1267.     Socket2.CCSockCancelListen;
  1268.     Socket2.CCSockClose;
  1269.     FTPCommandInProgress := false;
  1270.     PerformFTPCommand( 'TYPE A', [ nil ] );
  1271.     Through := false;
  1272.     repeat
  1273.       GetFTPServerResponse( TheReturnString );
  1274.       if Pos( 'TYPE' , Uppercase( TheReturnString )) > 0 then
  1275.        Through := true;
  1276.       { Put result in progress and status line }
  1277.       AddProgressText( TheReturnString );
  1278.       ShowProgressText( TheReturnString );
  1279.     until (( GlobalAbortedFlag ) or Through );
  1280.   end;
  1281.   _lclose( OutputFileHandle );
  1282.   FTPCommandInProgress := false;
  1283. end;
  1284.  
  1285. { This sends FTP progress text to the Inet form }
  1286. procedure TFTPComponent.ShowProgressErrorText( WhatText : String );
  1287. begin
  1288.   CCInetCCForm.ShowProgressErrorText( WhatText );
  1289. end;
  1290.  
  1291. { This is a core function! It performs an FTP command and if no timeout }
  1292. { return a preliminary ok.                                              }
  1293. function TFTPComponent.PerformFTPCommand(
  1294.                  TheCommand        : string;
  1295.            const TheArguments      : array of const ) : Integer;
  1296. var TheBuffer : string; { Text buffer }
  1297. begin
  1298.   { If command in progress send back -1 error }
  1299.   if FTPCommandInProgress then
  1300.   begin
  1301.     Result := -1;
  1302.     exit;
  1303.   end;
  1304.   { Set status variable }
  1305.   FTPCommandInProgress := True;
  1306.   { Set global error code }
  1307.   GlobalErrorCode := 0;
  1308.   { Format output string }
  1309.   TheBuffer := Format( TheCommand , TheArguments );
  1310.   { Preset failure code }
  1311.   Result := TCPIP_STATUS_FATAL_ERROR;
  1312.   { If invalid socket or no connection abort }
  1313.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  1314.    exit;
  1315.   { Send the buffer plus EOL chars }
  1316.   Socket1.StringData := TheBuffer + #13#10;
  1317.   { if abort due to timeout or other error exit }
  1318.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1319.   { Otherwise return preliminary code }
  1320.   Result := TCPIP_STATUS_PRELIMINARY;
  1321. end;
  1322.  
  1323. { This function gets up to 255 chars of data plus a return code from FTP serv }
  1324. function TFTPComponent.GetFTPServerResponse(
  1325.           var ResponseString : String ) : integer;
  1326. var
  1327.   { Buffer string for response line }
  1328.   TheBuffer     : string;
  1329.   { Pointer to the response string }
  1330.   BufferPointer : array[0..255] of char absolute TheBuffer;
  1331.   { Character to check for response code }
  1332.   ResponseChar   : char;
  1333.   { Pointers into returned string }
  1334.   TheIndex ,
  1335.   TheLength     : integer;
  1336.   { Control variable }
  1337.   LeftoversInPan ,
  1338.   Finished      : Boolean;
  1339. begin
  1340.   { Preset fatal error }
  1341.   Result := TCPIP_STATUS_FATAL_ERROR;
  1342.   { Start loop control }
  1343.   LeftoversInPan := false;
  1344.   Finished := false;
  1345.   repeat
  1346.     { Do a peek }
  1347.     TheBuffer := Socket1.PeekData;
  1348.     { If timeout or other error exit }
  1349.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1350.     { Find end of line character }
  1351.     TheIndex := Pos( #10 , TheBuffer );
  1352.     if TheIndex = 0 then
  1353.     begin
  1354.       TheIndex := Pos( #13 , TheBuffer );
  1355.       if TheIndex = 0 then
  1356.       begin
  1357.         TheIndex := Pos( #0 , TheBuffer );
  1358.         if TheIndex = 0 then
  1359.         begin
  1360.           TheIndex := Length( TheBuffer );
  1361.           LeftoversInPan := True;
  1362.           LeftoverText := LeftoverText + TheBuffer;
  1363.           LeftoversOnTable := false;
  1364.         end;
  1365.       end;
  1366.     end;
  1367.     { If an end of line then process the line }
  1368.     if TheIndex > 0 then
  1369.     begin
  1370.       { Get length of string }
  1371.       TheLength := TheIndex;
  1372.       { Receive actual data }
  1373.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  1374.                              @BufferPointer[ 1 ] ,
  1375.                              TheLength              );
  1376.       { Abort if timeout or error }
  1377.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  1378.       { Put in the length byte }
  1379.       BufferPointer[ 0 ] := Chr( TheLength );
  1380.       if LeftOversOnTable then
  1381.       begin
  1382.         LeftOversOnTable := false;
  1383.         ResponseString := LeftoverText + TheBuffer;
  1384.         TheBuffer := ResponseString;
  1385.         LeftoverText := '';
  1386.       end;
  1387.       if LeftoversInPan then
  1388.       begin
  1389.         LeftoversInPan := false;
  1390.         LeftoversOnTable := true;
  1391.       end;
  1392.       { If not a continuation line }
  1393.       if TheBuffer[ 4 ] <> '-' then
  1394.       begin
  1395.         { Get first number character }
  1396.         ResponseChar := TheBuffer[ 1 ];
  1397.         { Get the value of the number from 1 to 5 }
  1398.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  1399.         begin
  1400.           Finished := true;
  1401.           Result := Ord( ResponseChar ) - 48;
  1402.         end;
  1403.       end
  1404.       else
  1405.       begin
  1406.         { otherwise return preliminary result }
  1407.         Finished := true;
  1408.         Result := TCPIP_STATUS_PRELIMINARY;
  1409.       end;
  1410.     end
  1411.     else
  1412.     begin
  1413.     end;
  1414.   until ( Finished and ( not LeftoversOnTable ));
  1415.   { Return buffer as response string }
  1416.   ResponseString := TheBuffer;
  1417. end;
  1418.  
  1419. { Boilerplate error routine }
  1420. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  1421.                                                  ErrorCode  : Integer;
  1422.                                                  TheMessage : String   );
  1423. begin
  1424.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  1425. end;
  1426.  
  1427. { This is the FTP components initial connection routine }
  1428. function TFTPComponent.EstablishConnection(
  1429.           PCRPointer : PConnectionsRecord ) : Boolean;
  1430. var TheReturnString : String;  { Internal string holder }
  1431.     TheResult       : Integer; { Internal int holder    }
  1432. begin
  1433.   { Set default FTP Port value }
  1434.   Socket1.PortName := '21';
  1435.   { Get the ip address from the record }
  1436.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  1437.   { Set blocking mode }
  1438.   Socket1.AsynchMode := False;
  1439.   { Clear condition variables }
  1440.   GlobalErrorCode := 0;
  1441.   GlobalAbortedFlag := false;
  1442.   { Actually attempt to connect }
  1443.   Socket1.CCSockConnect;
  1444.   { Check if connected }
  1445.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  1446.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  1447.   begin { Didn't connect; signal error and abort }
  1448.     { Do clever C formatting trick }
  1449.     TheReturnString :=
  1450.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1451.       [ PCRPointer^.CIPAddress ] );
  1452.     { Put result in progress and status line }
  1453.     AddProgressText( TheReturnString );
  1454.     ShowProgressErrorText( TheReturnString );
  1455.     { Signal error }
  1456.     Result := False;
  1457.     { leave }
  1458.     exit;
  1459.   end
  1460.   else
  1461.   begin
  1462.     Connection_Established := true;
  1463.     { Signal successful connection }
  1464.     TheReturnString := DoCStyleFormat(
  1465.       'Connected on Local port: %s with IP: %s',
  1466.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  1467.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  1468.     { Put result in progress and status line }
  1469.     CCINetCCForm.AddProgressText( TheReturnString );
  1470.     CCINetCCForm.ShowProgressText( TheReturnString );
  1471.     TheReturnString := DoCStyleFormat(
  1472.      'Connected to Remote port: %s with IP: %s',
  1473.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  1474.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  1475.     { Put result in progress and status line }
  1476.     CCINetCCForm.AddProgressText( TheReturnString );
  1477.     CCINetCCForm.ShowProgressText( TheReturnString );
  1478.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  1479.      [ Socket1.IPAddressName ]);
  1480.     { Put result in progress and status line }
  1481.     CCINetCCForm.AddProgressText( TheReturnString );
  1482.     CCINetCCForm.ShowProgressText( TheReturnString );
  1483.     repeat
  1484.       TheResult := GetFTPServerResponse( TheReturnString );
  1485.       { Put result in progress and status line }
  1486.       AddProgressText( TheReturnString );
  1487.       ShowProgressText( TheReturnString );
  1488.     until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1489.     if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1490.     begin
  1491.       { Do clever C formatting trick }
  1492.       TheReturnString :=
  1493.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1494.         [ PCRPointer^.CIPAddress ] );
  1495.       { Put result in progress and status line }
  1496.       AddProgressText( TheReturnString );
  1497.       ShowProgressErrorText( TheReturnString );
  1498.       { Signal error }
  1499.       Result := False;
  1500.       { leave }
  1501.       exit;
  1502.     end
  1503.     else Result := true; { Signal no problem }
  1504.   end;
  1505. end;
  1506.  
  1507. { This is the FTP components USER login routine }
  1508. function TFTPComponent.LoginUser(
  1509.           PCRPointer : PConnectionsRecord ) : Boolean;
  1510. var TheReturnString : String;  { Internal string holder }
  1511.     TheResult       : Integer; { Internal int holder    }
  1512. begin
  1513.   TheReturnString :=
  1514.    DoCStyleFormat( 'USER %s' ,
  1515.     [ PCRPointer^.CUserName ] );
  1516.   { Put result in progress and status line }
  1517.   AddProgressText( TheReturnString );
  1518.   ShowProgressText( TheReturnString );
  1519.   { Begin login sequence with user name }
  1520.   TheResult := PerformFTPCommand( 'USER %s',
  1521.                                   [ PCRPointer^.CUserName ] );
  1522.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1523.   begin
  1524.     FTPCommandInProgress := false;
  1525.     Result := false;
  1526.     exit;
  1527.   end;
  1528.   repeat
  1529.     TheResult := GetFTPServerResponse( TheReturnString );
  1530.     { Put result in progress and status line }
  1531.     AddProgressText( TheReturnString );
  1532.     ShowProgressText( TheReturnString );
  1533.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1534.   FTPCommandInProgress := false;
  1535.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_CONTINUING )) then
  1536.   begin
  1537.     { Do clever C formatting trick }
  1538.     TheReturnString :=
  1539.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1540.       [ PCRPointer^.CIPAddress ] );
  1541.     { Put result in progress and status line }
  1542.     AddProgressText( TheReturnString );
  1543.     ShowProgressErrorText( TheReturnString );
  1544.     { Signal error }
  1545.     Result := False;
  1546.     { leave }
  1547.     exit;
  1548.   end
  1549.   else Result := true; { Signal no problem }
  1550. end;
  1551.  
  1552. function TFTPComponent.DeleteRemoteDirectory( TheDir : String ) : Boolean;
  1553. var TheReturnString : String;  { Internal string holder }
  1554.     TheResult       : Integer; { Internal int holder    }
  1555. begin
  1556.   TheReturnString := DoCStyleFormat( 'RMD %s' ,
  1557.    [ TheDir ] );
  1558.   { Put result in progress and status line }
  1559.   AddProgressText( TheReturnString );
  1560.   ShowProgressText( TheReturnString );
  1561.   { Send Password sequence }
  1562.   TheResult := PerformFTPCommand( 'RMD %s',
  1563.                                   [ TheDir ] );
  1564.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1565.   begin
  1566.     Result := false;
  1567.     FTPCommandInProgress := false;
  1568.     exit;
  1569.   end;
  1570.   repeat
  1571.     TheResult := GetFTPServerResponse( TheReturnString );
  1572.     { Put result in progress and status line }
  1573.     AddProgressText( TheReturnString );
  1574.     ShowProgressText( TheReturnString );
  1575.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1576.   FTPCommandInProgress := false;
  1577.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1578.   begin
  1579.     { Do clever C formatting trick }
  1580.     TheReturnString :=
  1581.      DoCStyleFormat( 'Delete Directory %s Failed!' ,
  1582.       [ TheDir ] );
  1583.     { Put result in progress and status line }
  1584.     AddProgressText( TheReturnString );
  1585.     ShowProgressErrorText( TheReturnString );
  1586.     { Signal error }
  1587.     Result := False;
  1588.     { leave }
  1589.     exit;
  1590.   end
  1591.   else Result := true; { Signal no problem }
  1592. end;
  1593.  
  1594. function TFTPComponent.CreateRemoteDirectory( TheDir : String ) : Boolean;
  1595. var TheReturnString : String;  { Internal string holder }
  1596.     TheResult       : Integer; { Internal int holder    }
  1597. begin
  1598.   TheReturnString := DoCStyleFormat( 'MKD %s' ,
  1599.     [ TheDir ] );
  1600.   { Put result in progress and status line }
  1601.   AddProgressText( TheReturnString );
  1602.   ShowProgressText( TheReturnString );
  1603.   { Send Password sequence }
  1604.   TheResult := PerformFTPCommand( 'MKD %s',
  1605.                                   [ TheDir ] );
  1606.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1607.   begin
  1608.     Result := false;
  1609.     FTPCommandInProgress := false;
  1610.     exit;
  1611.   end;
  1612.   repeat
  1613.     TheResult := GetFTPServerResponse( TheReturnString );
  1614.     { Put result in progress and status line }
  1615.     AddProgressText( TheReturnString );
  1616.     ShowProgressText( TheReturnString );
  1617.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1618.   FTPCommandInProgress := false;
  1619.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1620.   begin
  1621.     { Do clever C formatting trick }
  1622.     TheReturnString :=
  1623.      DoCStyleFormat( 'Create Directory %s Failed!' ,
  1624.       [ TheDir ] );
  1625.     { Put result in progress and status line }
  1626.     AddProgressText( TheReturnString );
  1627.     ShowProgressErrorText( TheReturnString );
  1628.     { Signal error }
  1629.     Result := False;
  1630.     { leave }
  1631.     exit;
  1632.   end
  1633.   else Result := true; { Signal no problem }
  1634. end;
  1635.  
  1636.  
  1637. function TFTPComponent.DeleteRemoteFile( TheFileName : String ) : Boolean;
  1638. var TheReturnString : String;  { Internal string holder }
  1639.     TheResult       : Integer; { Internal int holder    }
  1640. begin
  1641.   TheReturnString := DoCStyleFormat( 'DELE %s' ,
  1642.     [ TheFileName ] );
  1643.   { Put result in progress and status line }
  1644.   AddProgressText( TheReturnString );
  1645.   ShowProgressText( TheReturnString );
  1646.   { Send Password sequence }
  1647.   TheResult := PerformFTPCommand( 'DELE %s',
  1648.                                   [ TheFileName ] );
  1649.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1650.   begin
  1651.     Result := false;
  1652.     FTPCommandInProgress := false;
  1653.     exit;
  1654.   end;
  1655.   repeat
  1656.     TheResult := GetFTPServerResponse( TheReturnString );
  1657.     { Put result in progress and status line }
  1658.     AddProgressText( TheReturnString );
  1659.     ShowProgressText( TheReturnString );
  1660.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1661.   FTPCommandInProgress := false;
  1662.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1663.   begin
  1664.     { Do clever C formatting trick }
  1665.     TheReturnString :=
  1666.      DoCStyleFormat( 'Delete File %s Failed!' ,
  1667.       [ TheFileName ] );
  1668.     { Put result in progress and status line }
  1669.     AddProgressText( TheReturnString );
  1670.     ShowProgressErrorText( TheReturnString );
  1671.     { Signal error }
  1672.     Result := False;
  1673.     { leave }
  1674.     exit;
  1675.   end
  1676.   else Result := true; { Signal no problem }
  1677. end;
  1678.  
  1679. { This is the FTP components PASSWORD routine }
  1680. function TFTPComponent.SendPassword(
  1681.           PCRPointer : PConnectionsRecord ) : Boolean;
  1682. var TheReturnString : String;  { Internal string holder }
  1683.     TheResult       : Integer; { Internal int holder    }
  1684. begin
  1685.   TheReturnString := 'PASS XXXXXX' + #13#10;
  1686.   { Put result in progress and status line }
  1687.   AddProgressText( TheReturnString );
  1688.   ShowProgressText( TheReturnString );
  1689.   { Send Password sequence }
  1690.   TheResult := PerformFTPCommand( 'PASS %s',
  1691.                                   [ PCRPointer^.CPassword ] );
  1692.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1693.   begin
  1694.     Result := false;
  1695.     FTPCommandInProgress := false;
  1696.     exit;
  1697.   end;
  1698.   repeat
  1699.     TheResult := GetFTPServerResponse( TheReturnString );
  1700.     { Put result in progress and status line }
  1701.     AddProgressText( TheReturnString );
  1702.     ShowProgressText( TheReturnString );
  1703.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1704.   FTPCommandInProgress := false;
  1705.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1706.   begin
  1707.     { Do clever C formatting trick }
  1708.     TheReturnString :=
  1709.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  1710.       [ PCRPointer^.CIPAddress ] );
  1711.     { Put result in progress and status line }
  1712.     AddProgressText( TheReturnString );
  1713.     ShowProgressErrorText( TheReturnString );
  1714.     { Signal error }
  1715.     Result := False;
  1716.     { leave }
  1717.     exit;
  1718.   end
  1719.   else Result := true; { Signal no problem }
  1720. end;
  1721.  
  1722. { This is the FTP components CWD routine }
  1723. function TFTPComponent.SetRemoteStartupDirectory(
  1724.           PCRPointer : PConnectionsRecord ) : Boolean;
  1725. var TheReturnString : String;  { Internal string holder }
  1726.     TheResult       : Integer; { Internal int holder    }
  1727. begin
  1728.   Result := true;
  1729.   if PCRPointer^.CStartDir <> '' then
  1730.   begin
  1731.     TheReturnString :=
  1732.      DoCStyleFormat( 'CWD %s' ,
  1733.       [ PCRPointer^.CStartDir ] );
  1734.     { Put result in progress and status line }
  1735.     AddProgressText( TheReturnString );
  1736.     ShowProgressText( TheReturnString );
  1737.     { Send Password sequence }
  1738.     TheResult := PerformFTPCommand( 'CWD %s',
  1739.                                     [ PCRPointer^.CStartDir ] );
  1740.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1741.     begin
  1742.       Result := false;
  1743.       FTPCommandInProgress := false;
  1744.       exit;
  1745.     end;
  1746.     repeat
  1747.       TheResult := GetFTPServerResponse( TheReturnString );
  1748.       { Put result in progress and status line }
  1749.       AddProgressText( TheReturnString );
  1750.       ShowProgressText( TheReturnString );
  1751.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1752.    FTPCommandInProgress := false;
  1753.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1754.     begin
  1755.       { Do clever C formatting trick }
  1756.       TheReturnString :=
  1757.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1758.         [ PCRPointer^.CStartDir ] );
  1759.       { Put result in progress and status line }
  1760.       AddProgressText( TheReturnString );
  1761.       ShowProgressErrorText( TheReturnString );
  1762.       { Signal error }
  1763.       Result := False;
  1764.       { leave }
  1765.       exit;
  1766.     end
  1767.     else Result := true; { Signal no problem }
  1768.   end;
  1769. end;
  1770.  
  1771. { This is the FTP components CWD routine }
  1772. function TFTPComponent.SetRemoteDirectory( TheDir : String ) : Boolean;
  1773. var TheReturnString : String;  { Internal string holder }
  1774.     TheResult       : Integer; { Internal int holder    }
  1775. begin
  1776.   Result := true;
  1777.   if TheDir <> '' then
  1778.   begin
  1779.     TheReturnString :=
  1780.      DoCStyleFormat( 'CWD %s' ,
  1781.       [ TheDir ] );
  1782.     { Put result in progress and status line }
  1783.     AddProgressText( TheReturnString );
  1784.     ShowProgressText( TheReturnString );
  1785.     { Send Password sequence }
  1786.     TheResult := PerformFTPCommand( 'CWD %s',
  1787.                                     [ TheDir ] );
  1788.     if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1789.     begin
  1790.       Result := false;
  1791.       FTPCommandInProgress := false;
  1792.       exit;
  1793.     end;
  1794.     repeat
  1795.       TheResult := GetFTPServerResponse( TheReturnString );
  1796.       { Put result in progress and status line }
  1797.       AddProgressText( TheReturnString );
  1798.       ShowProgressText( TheReturnString );
  1799.    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1800.    FTPCommandInProgress := false;
  1801.    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1802.     begin
  1803.       { Do clever C formatting trick }
  1804.       TheReturnString :=
  1805.        DoCStyleFormat( 'CWD to %s Failed!' ,
  1806.         [ TheDir ] );
  1807.       { Put result in progress and status line }
  1808.       AddProgressText( TheReturnString );
  1809.       ShowProgressErrorText( TheReturnString );
  1810.       { Signal error }
  1811.       Result := False;
  1812.       { leave }
  1813.       exit;
  1814.     end
  1815.     else Result := true; { Signal no problem }
  1816.   end;
  1817. end;
  1818.  
  1819. { This is the FTP components QUIT routine }
  1820. function TFTPComponent.Disconnect : Boolean;
  1821. var TheReturnString : String;  { Internal string holder }
  1822.     TheResult       : Integer; { Internal int holder    }
  1823. begin
  1824.   TheReturnString :=
  1825.    DoCStyleFormat( 'QUIT' ,
  1826.     [ nil ] );
  1827.   { Put result in progress and status line }
  1828.   AddProgressText( TheReturnString );
  1829.   ShowProgressText( TheReturnString );
  1830.   { Begin login sequence with user name }
  1831.   PerformFTPCommand( 'QUIT', [ nil ] );
  1832.   repeat
  1833.     TheResult := GetFTPServerResponse( TheReturnString );
  1834.     { Put result in progress and status line }
  1835.     AddProgressText( TheReturnString );
  1836.     ShowProgressText( TheReturnString );
  1837.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1838.   FTPCommandInProgress := false;
  1839.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1840.   begin
  1841.     { Do clever C formatting trick }
  1842.     TheReturnString :=
  1843.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1844.       [ nil ] );
  1845.     { Put result in progress and status line }
  1846.     AddProgressText( TheReturnString );
  1847.     ShowProgressErrorText( TheReturnString );
  1848.     { Signal error }
  1849.     Result := False;
  1850.     { leave }
  1851.     exit;
  1852.   end
  1853.   else Result := true; { Signal no problem }
  1854. end;
  1855.  
  1856. { This is the FTP components PWD routine }
  1857. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : String )
  1858.           : Boolean;
  1859. var TheReturnString : String;  { Internal string holder }
  1860.     TheResult       : Integer; { Internal int holder    }
  1861. begin
  1862.   TheReturnString :=
  1863.    DoCStyleFormat( 'PWD' ,
  1864.     [ nil ] );
  1865.   { Put result in progress and status line }
  1866.   AddProgressText( TheReturnString );
  1867.   ShowProgressText( TheReturnString );
  1868.   { Send Password sequence }
  1869.   TheResult := PerformFTPCommand( 'PWD',
  1870.                                   [ nil ] );
  1871.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1872.   begin
  1873.     Result := false;
  1874.     FTPCommandInProgress := false;
  1875.     exit;
  1876.   end;
  1877.   repeat
  1878.     TheResult := GetFTPServerResponse( TheReturnString );
  1879.     { Put result in progress and status line }
  1880.     AddProgressText( TheReturnString );
  1881.     ShowProgressText( TheReturnString );
  1882.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1883.   FTPCommandInProgress := false;
  1884.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1885.   begin
  1886.     { Do clever C formatting trick }
  1887.     TheReturnString :=
  1888.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1889.       [ nil ] );
  1890.     { Put result in progress and status line }
  1891.     AddProgressText( TheReturnString );
  1892.     ShowProgressErrorText( TheReturnString );
  1893.     { Signal error }
  1894.     Result := False;
  1895.     { leave }
  1896.     exit;
  1897.   end
  1898.   else
  1899.   begin
  1900.     Result := true; { Signal no problem }
  1901.     RemoteDir := TheReturnString; { Send back last string on faith }
  1902.   end;
  1903. end;
  1904.  
  1905. { This function sets up a listening port on socekt 2 and handle text replies }
  1906. function TFTPComponent.GetListeningPort : Integer;
  1907. var
  1908.   Address1 ,
  1909.   Address2 ,
  1910.   Address3 ,
  1911.   Address4        : integer; { Address integer conversions }
  1912.   IPAddress       : string;  { IP Address holder           }
  1913.   PortCommand     : string;  { Command holder              }
  1914.   TheResult       : Integer; { Result holder               }
  1915.   TheReturnString : String;  { ditto                       }
  1916. begin
  1917.   { Set up any port on socket 2 }
  1918.   Socket2.PortName := '0';
  1919.   { Listen on a socket }
  1920.   Socket2.CCSockListen;
  1921.   { Get the IP Address of socket 1 and convert it to numbers }
  1922.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  1923.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1924.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1925.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  1926.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  1927.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  1928.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  1929.   { Turn it into a command and add socket 2 stuff }
  1930.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  1931.    [ Address1 , Address2 , Address3 , Address4 ,
  1932.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  1933.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  1934.   { Put result in progress and status line }
  1935.   AddProgressText( PortCommand + #13#10 );
  1936.   ShowProgressText( PortCommand  + #13#10 );
  1937.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  1938.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  1939.   begin
  1940.     Result := TCPIP_STATUS_FATAL_ERROR;
  1941.     FTPCommandInProgress := false;
  1942.     exit;
  1943.   end;
  1944.   repeat
  1945.     TheResult := GetFTPServerResponse( TheReturnString );
  1946.     { Put result in progress and status line }
  1947.     AddProgressText( TheReturnString );
  1948.     ShowProgressText( TheReturnString );
  1949.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  1950.   FTPCommandInProgress := false;
  1951.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  1952.   begin
  1953.     { Do clever C formatting trick }
  1954.     TheReturnString :=
  1955.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1956.       [ nil ] );
  1957.     { Put result in progress and status line }
  1958.     AddProgressText( TheReturnString );
  1959.     ShowProgressErrorText( TheReturnString );
  1960.     { Signal error }
  1961.     Result := TheResult;
  1962.     { leave }
  1963.     exit;
  1964.   end
  1965.   else
  1966.   begin
  1967.     { Return good result and leave }
  1968.     Result := TheResult;
  1969.     exit;
  1970.   end;
  1971. end;
  1972.  
  1973. { This function returns part of a unit text string }
  1974. function TFTPComponent.GetUNIXTextString( var StringIn : String ) : String;
  1975. var
  1976.   ReturnString : String;
  1977.   TheLength ,
  1978.   Counter_1   : integer;
  1979. begin
  1980.   TheLength := Length( StringIn );
  1981.   if TheLength > 1 then
  1982.   begin
  1983.     for Counter_1 := 1 to TheLength do
  1984.     begin
  1985.       if StringIn[ Counter_1 ] = #10 then
  1986.       begin
  1987.         ReturnString := HolderLine;
  1988.         HolderLine := '';
  1989.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  1990.         Result := ReturnString;
  1991.         exit;
  1992.       end
  1993.       else
  1994.       begin
  1995.         if StringIn[ Counter_1 ] <> #0 then
  1996.         begin
  1997.           if StringIn[ Counter_1 ] <> #13 then
  1998.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  1999.         end
  2000.         else
  2001.         begin
  2002.           Result := '';
  2003.           StringIn := '';
  2004.         end;
  2005.       end;
  2006.     end;
  2007.   end;
  2008.   Result := '';
  2009.   StringIn := '';
  2010. end;
  2011.  
  2012. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : String );
  2013. var Counter_1 : Integer;
  2014.     ResultString : String;
  2015.     Finished : Boolean;
  2016. begin
  2017.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  2018.   begin
  2019.     TheName := '';
  2020.     exit;
  2021.   end;
  2022.   Counter_1 := Length( TheName );
  2023.   ResultString := '';
  2024.   Finished := false;
  2025.   while not Finished do
  2026.   begin
  2027.     if TheName[ Counter_1 ] <> ' ' then
  2028.     begin
  2029.       Counter_1 := Counter_1 - 1;
  2030.       if Counter_1 = 0 then
  2031.       begin
  2032.         ResultString := TheName;
  2033.         Finished := true;
  2034.       end;
  2035.     end
  2036.     else
  2037.     begin
  2038.       Finished := true;
  2039.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  2040.     end;
  2041.   end;
  2042.   TheName := ResultString;
  2043. end;
  2044.  
  2045. { This is the FTP components get remote directory listing into a list box }
  2046. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  2047.           : Boolean;
  2048. var TheReturnString : String;  { Internal string holder }
  2049.     TheResult       : Integer; { Internal int holder    }
  2050.     InputString     : String;
  2051.     Through ,
  2052.     Finished        : Boolean;
  2053. begin
  2054.   TheListBox.Clear;
  2055.   TheListbox.Tag := 2;
  2056.   TheListBox.Items.Add('..');
  2057.   Result := true;
  2058.   TheReturnString :=
  2059.    DoCStyleFormat( 'TYPE A' ,
  2060.     [ nil ] );
  2061.   { Put result in progress and status line }
  2062.   AddProgressText( TheReturnString );
  2063.   ShowProgressText( TheReturnString );
  2064.   { Send Password sequence }
  2065.   TheResult := PerformFTPCommand( 'TYPE A',
  2066.                                   [ nil ] );
  2067.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2068.   begin
  2069.     Result := true;
  2070.     FTPCommandInProgress := false;
  2071.     exit;
  2072.   end;
  2073.   repeat
  2074.     TheResult := GetFTPServerResponse( TheReturnString );
  2075.     { Put result in progress and status line }
  2076.     AddProgressText( TheReturnString );
  2077.     ShowProgressText( TheReturnString );
  2078.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2079.   FTPCommandInProgress := false;
  2080.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2081.   begin
  2082.     { Do clever C formatting trick }
  2083.     TheReturnString :=
  2084.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2085.       [ nil ] );
  2086.     { Put result in progress and status line }
  2087.     AddProgressText( TheReturnString );
  2088.     ShowProgressErrorText( TheReturnString );
  2089.     { Signal error }
  2090.     Result := true;
  2091.     { leave }
  2092.     exit;
  2093.   end
  2094.   else
  2095.   begin
  2096.     { Set up socket 2 for listening }
  2097.     Socket2.AsynchMode := False;
  2098.     Socket2.NonAsynchTimeoutValue := 60;
  2099.     { do a listen and send command to server that this is receipt socket }
  2100.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2101.     begin
  2102.       Socket2.CCSockCancelListen;
  2103.       exit;
  2104.     end;
  2105.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2106.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2107.     GetFTPServerResponse( TheReturnString );
  2108.     AddProgressText( TheReturnString );
  2109.     ShowProgressText( TheReturnString );
  2110.     Socket1.NonAsynchTimeoutValue := 30;
  2111.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2112.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2113.     begin
  2114.       TheReturnString :=
  2115.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2116.         [ nil ] );
  2117.       { Put result in progress and status line }
  2118.       AddProgressText( TheReturnString );
  2119.       ShowProgressErrorText( TheReturnString );
  2120.       Socket2.CCSockCancelListen;
  2121.       Result := true;
  2122.       exit;
  2123.     end;
  2124.     Socket2.CCSockAccept;
  2125.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2126.     begin
  2127.       TheReturnString :=
  2128.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2129.         [ nil ] );
  2130.       { Put result in progress and status line }
  2131.       AddProgressText( TheReturnString );
  2132.       ShowProgressErrorText( TheReturnString );
  2133.       Result := true;
  2134.       exit;
  2135.     end;
  2136.     Through := false;
  2137.     repeat
  2138.       TheReturnString := Socket2.StringData;
  2139.       if Length( TheReturnString ) = 0 then Through := true;
  2140.       if Length( TheReturnString ) > 0 then
  2141.       begin
  2142.         finished := false;
  2143.         while not finished do
  2144.         begin
  2145.           InputString := GetUNIXTextString( TheReturnString );
  2146.           if InputString = '' then Finished := true else
  2147.           begin
  2148.             GetFileNameFromUNIXFileName( InputString);
  2149.             If InputString <> '' then
  2150.             TheListBox.Items.Add( InputString );
  2151.           end;
  2152.         end;
  2153.       end;
  2154.       if GlobalAbortedFlag then
  2155.       begin
  2156.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2157.         repeat
  2158.           TheResult := GetFTPServerResponse( TheReturnString );
  2159.           { Put result in progress and status line }
  2160.           AddProgressText( TheReturnString );
  2161.           ShowProgressText( TheReturnString );
  2162.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2163.         result := true;
  2164.         exit;
  2165.       end;
  2166.     until Through;
  2167.     GetFTPServerResponse( TheReturnString );
  2168.     AddProgressText( TheReturnString );
  2169.     ShowProgressText( TheReturnString );
  2170.     { cancel listening on second socket and close it }
  2171.     Socket2.CCSockCancelListen;
  2172.     Socket2.CCSockClose;
  2173.   end;
  2174.   FTPCommandInProgress := false;
  2175. end;
  2176.  
  2177. { This is the FTP components get remote directory listing into a list box }
  2178. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  2179. var TheReturnString : String;  { Internal string holder }
  2180.     TheResult       : Integer; { Internal int holder    }
  2181.     Through         : Boolean;
  2182. begin
  2183.   Result := true;
  2184.   TheReturnString :=
  2185.    DoCStyleFormat( 'TYPE A' ,
  2186.     [ nil ] );
  2187.   { Put result in progress and status line }
  2188.   AddProgressText( TheReturnString );
  2189.   ShowProgressText( TheReturnString );
  2190.   { Send Password sequence }
  2191.   TheResult := PerformFTPCommand( 'TYPE A',
  2192.                                   [ nil ] );
  2193.   if TheResult <> TCPIP_STATUS_PRELIMINARY then
  2194.   begin
  2195.     Result := true;
  2196.     FTPCommandInProgress := false;
  2197.     exit;
  2198.   end;
  2199.   repeat
  2200.     TheResult := GetFTPServerResponse( TheReturnString );
  2201.     { Put result in progress and status line }
  2202.     AddProgressText( TheReturnString );
  2203.     ShowProgressText( TheReturnString );
  2204.   until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2205.   FTPCommandInProgress := false;
  2206.   if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  2207.   begin
  2208.     { Do clever C formatting trick }
  2209.     TheReturnString :=
  2210.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  2211.       [ nil ] );
  2212.     { Put result in progress and status line }
  2213.     AddProgressText( TheReturnString );
  2214.     ShowProgressErrorText( TheReturnString );
  2215.     { Signal error }
  2216.     Result := true;
  2217.     { leave }
  2218.     exit;
  2219.   end
  2220.   else
  2221.   begin
  2222.     { Set up socket 2 for listening }
  2223.     Socket2.AsynchMode := False;
  2224.     Socket2.NonAsynchTimeoutValue := 30;
  2225.     { do a listen and send command to server that this is receipt socket }
  2226.     if GetListeningPort = TCPIP_STATUS_FATAL_ERROR then
  2227.     begin
  2228.       Socket2.CCSockCancelListen;
  2229.       exit;
  2230.     end;
  2231.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  2232.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  2233.     GetFTPServerResponse( TheReturnString );
  2234.     AddProgressText( TheReturnString );
  2235.     ShowProgressText( TheReturnString );
  2236.     Socket1.NonAsynchTimeoutValue := 30;
  2237.     if (( TheResult = TCPIP_STATUS_RETRY_COMMAND ) or
  2238.        ( TheResult = TCPIP_STATUS_FATAL_ERROR )) then
  2239.     begin
  2240.       TheReturnString :=
  2241.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  2242.         [ nil ] );
  2243.       { Put result in progress and status line }
  2244.       AddProgressText( TheReturnString );
  2245.       ShowProgressErrorText( TheReturnString );
  2246.       Socket2.CCSockCancelListen;
  2247.       Result := true;
  2248.       exit;
  2249.     end;
  2250.     Socket2.CCSockAccept;
  2251.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  2252.     begin
  2253.       TheReturnString :=
  2254.        DoCStyleFormat( 'Could not establish receive socket!' ,
  2255.         [ nil ] );
  2256.       { Put result in progress and status line }
  2257.       AddProgressText( TheReturnString );
  2258.       ShowProgressErrorText( TheReturnString );
  2259.       Result := true;
  2260.       exit;
  2261.     end;
  2262.     Through := false;
  2263.     repeat
  2264.       TheReturnString := Socket2.StringData;
  2265.       if Length( TheReturnString ) = 0 then Through := true;
  2266.       if Length( TheReturnString ) > 0 then
  2267.       begin
  2268.         { Put result in progress and status line }
  2269.         AddProgressText( TheReturnString );
  2270.         ShowProgressText( TheReturnString );
  2271.       end;
  2272.       if GlobalAbortedFlag then
  2273.       begin
  2274.         Socket1.OutOfBand := 'ABOR'+#13#10;
  2275.         repeat
  2276.           TheResult := GetFTPServerResponse( TheReturnString );
  2277.           { Put result in progress and status line }
  2278.           AddProgressText( TheReturnString );
  2279.           ShowProgressText( TheReturnString );
  2280.         until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  2281.         result := true;
  2282.         exit;
  2283.       end;
  2284.     until Through;
  2285.     GetFTPServerResponse( TheReturnString );
  2286.     AddProgressText( TheReturnString );
  2287.     ShowProgressText( TheReturnString );
  2288.     { cancel listening on second socket and close it }
  2289.     Socket2.CCSockCancelListen;
  2290.     Socket2.CCSockClose;
  2291.   end;
  2292. end;
  2293.  
  2294. { This is the FTP components get local directory listing into a list box }
  2295. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : String;
  2296.                                                         TheListBox : TListBox )
  2297.           : Boolean;
  2298. var TheFLB : TFileListBox;
  2299. begin
  2300.   { Get the working directory }
  2301.   GetDir( 0 , TheString );
  2302.   { Clear incoming LB }
  2303.   TheListBox.Clear;
  2304.   TheListBox.Tag := 2;
  2305.   TheFLB := TFileListBox.Create( Application.MainForm );
  2306.   TheFLB.Visible := false;
  2307.   TheFLB.Parent := Application.MainForm;
  2308.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  2309.   TheFLB.Directory := TheString;
  2310.   TheFLB.Update;
  2311.   TheListBox.Items.Assign( TheFLB.Items );
  2312.   TheFLB.Free;
  2313.   result := true;
  2314. end;
  2315.  
  2316. { This is a clever c-style formatting trick }
  2317. function TFTPComponent.DoCStyleFormat(
  2318.                 TheText      : string;
  2319.           const TheArguments : array of const ) : String;
  2320. begin
  2321.   Result := Format( TheText , TheArguments ) + #13#10;
  2322. end;
  2323.  
  2324. function TFTPComponent.GetQuotedString( TheString : String ) : String;
  2325. var TheIndex     : Integer; { Holder var }
  2326.     ResultString : String;  { ditto      }
  2327. begin
  2328.   { Find out if " present at all }
  2329.   TheIndex := Pos( '"' , TheString );
  2330.   If TheIndex = 0 then
  2331.   begin
  2332.     { If not, return null string and exit }
  2333.     Result := '';
  2334.     exit;
  2335.   end
  2336.   else
  2337.   begin
  2338.     { Get from first " to end of string in holder }
  2339.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  2340.     { Find position to second " }
  2341.     TheIndex := Pos( '"' , ResultString );
  2342.     { If no ending " then return whole string and leave }
  2343.     if TheIndex = 0 then
  2344.     begin
  2345.       Result := ResultString;
  2346.       exit;
  2347.     end
  2348.     else
  2349.     begin
  2350.       { Get internal text between quotes and exit }
  2351.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  2352.       Result := ResultString;
  2353.     end;
  2354.   end;
  2355. end;
  2356.  
  2357. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  2358. var
  2359.   Percentage : longint;
  2360. begin
  2361.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2362.   if TotalToHandle = 0 then exit;
  2363.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2364.   Gauge1.Progress := Percentage;
  2365.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2366.    ' bytes ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Done)';
  2367. end;
  2368.  
  2369. procedure TCCINetCCForm.UpdateUUGauge( BytesFinished , TotalToHandle : longint );
  2370. var
  2371.   Percentage : longint;
  2372. begin
  2373.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  2374.   if TotalToHandle = 0 then exit;
  2375.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  2376.   Gauge1.Progress := Percentage;
  2377.   Panel1.Caption := '  Status: ' + IntToStr( BytesFinished ) +
  2378.    ' bytes UUCode (' + IntToStr( Percentage ) + '% Done)';
  2379.   Panel1.Show;
  2380. end;
  2381.  
  2382. { This procedure actually attempts to connect to the internet at an ftp site }
  2383. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2384. var TheReturnString : String; { Display results of connection in status lines }
  2385. begin
  2386.   { Create the component }
  2387.   Result := false;
  2388.   { Do busy cursors }
  2389.   SetHGCursors;
  2390.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  2391.   begin
  2392.     { Do saved cursors }
  2393.     TheFTPComponent.FTPCommandInProgress := false;
  2394.     TheFTPComponent.Connection_Established := false;
  2395.     SetNormalCursors;
  2396.     exit;
  2397.   end
  2398.   else
  2399.   begin { Connected; continue login process }
  2400.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  2401.     begin
  2402.       { Do saved cursors }
  2403.       TheFTPComponent.FTPCommandInProgress := false;
  2404.       TheFTPComponent.Connection_Established := false;
  2405.       SetNormalCursors;
  2406.       exit;
  2407.     end;
  2408.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  2409.     begin
  2410.       { Do saved cursors }
  2411.       TheFTPComponent.FTPCommandInProgress := false;
  2412.       TheFTPComponent.Connection_Established := false;
  2413.       SetNormalCursors;
  2414.       exit;
  2415.     end;
  2416.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  2417.     begin
  2418.       { Do saved cursors }
  2419.       SetNormalCursors;
  2420.       TheFTPComponent.Connection_Established := false;
  2421.       TheFTPComponent.FTPCommandInProgress := false;
  2422.       exit;
  2423.     end;
  2424.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  2425.     begin
  2426.       { Do saved cursors }
  2427.       TheFTPComponent.Connection_Established := false;
  2428.       TheFTPComponent.FTPCommandInProgress := false;
  2429.       SetNormalCursors;
  2430.       exit;
  2431.     end;
  2432.     { Put up remote directory via PWD and strip quotes }
  2433.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  2434.     { Get the listings of directories and exit OK }
  2435.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2436.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  2437.      Listbox2 );
  2438.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  2439.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  2440.     Label5.Caption := TheReturnString;
  2441.     SetNormalCursors;
  2442.     Result := true;
  2443.     EnableFTPMenus;
  2444.     TheFTPComponent.FTPCommandInProgress := false;
  2445.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2446.   end;
  2447. end;
  2448.  
  2449. { This procedure actually attempts to connect to the internet at an nntp site }
  2450. function TCCINetCCForm.DoNNTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  2451. begin
  2452.   { Create the component }
  2453.   Result := false;
  2454.   { Do busy cursors }
  2455.   SetHGCursors;
  2456.   if not TheNNTPComponent.EstablishConnection( PCRPointer ) then
  2457.   begin
  2458.     { Do saved cursors }
  2459.     TheNNTPComponent.NNTPCommandInProgress := false;
  2460.     TheNNTPComponent.Connection_Established := false;
  2461.     SetNormalCursors;
  2462.     exit;
  2463.   end
  2464.   else
  2465.   begin { Connected; continue login process }
  2466.     SetNormalCursors;
  2467.     Result := true;
  2468.     EnableNNTPMenus;
  2469.     TheNNTPComponent.NNTPCommandInProgress := false;
  2470.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  2471.   end;
  2472. end;
  2473.  
  2474. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2475. procedure TCCINetCCForm.DoFTPDisconnect;
  2476. begin
  2477.   { Call QUIT command }
  2478.   TheFTPComponent.Disconnect;
  2479.   { Kill the socket }
  2480.   TheFTPComponent.Socket1.CCSockClose;
  2481. end;
  2482.  
  2483. { This procedure actually attempts to disconnect to the internet at an ftp site}
  2484. procedure TCCINetCCForm.DoNNTPDisconnect;
  2485. begin
  2486.   { Call QUIT command }
  2487.   TheNNTPComponent.Disconnect;
  2488.   { Kill the socket }
  2489.   TheNNTPComponent.Socket1.CCSockClose;
  2490. end;
  2491.  
  2492. { This procedure reads in the ini file and default path info }
  2493. procedure TCCINetCCForm.ReadIniData;
  2494. begin
  2495.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2496.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  2497.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  2498.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  2499.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  2500.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  2501.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  2502.   NewsReadArticlePurgingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsPurge', 1 );
  2503.   NewsPostQueueingVector := TheICCIniFile.ReadInteger( 'Vectors','NewsQueue', 1 );
  2504.   NewsReadArticleDisplayVector := TheICCIniFile.ReadInteger( 'Vectors','NewsRDisp', 1 );
  2505.   NewsUUMIMEVector := TheICCIniFile.ReadInteger( 'Vectors','NewsUUMIME', 2 );
  2506.   NewsInitialUpdateVector := TheICCIniFile.ReadInteger( 'Vectors','NewsInitUD', 1 );
  2507.   EMPasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','EMPWControl', 1 );
  2508.   EMRemoteDeletionVector  := TheICCIniFile.ReadInteger( 'Vectors','EMRemDel', 2 );
  2509.   EMChokeVector           := TheICCIniFile.ReadInteger( 'Vectors','EMChoke', 1 );
  2510.   EMDefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','EMInitUD', 1 );
  2511.   EMQueueVector           := TheICCIniFile.ReadInteger( 'Vectors','EMQueue', 1 );
  2512.   TheICCIniFile.Free;
  2513. end;
  2514.  
  2515. { This procedure writes out default path data to the ini file }
  2516. procedure TCCINetCCForm.WriteIniData;
  2517. begin
  2518.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  2519.   TheICCIniFile.WriteString( 'Paths','MailPath', MailPath );
  2520.   TheICCIniFile.WriteString( 'Paths','NewsPath', NewsPath );
  2521.   TheICCIniFile.WriteString( 'Paths','FTPPath', FTPPath );
  2522.   TheICCIniFile.WriteInteger( 'Vectors','PWControl', PasswordControlVector );
  2523.   TheICCIniFile.WriteInteger( 'Vectors','DefDL', DefaultDownloadVector );
  2524.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  2525.   TheICCIniFile.WriteInteger( 'Vectors','NewsPurge',
  2526.    NewsReadArticlePurgingVector );
  2527.   TheICCIniFile.WriteInteger( 'Vectors','NewsQueue', NewsPostQueueingVector );
  2528.   TheICCIniFile.WriteInteger( 'Vectors','NewsRDisp',
  2529.    NewsReadArticleDisplayVector );
  2530.   TheICCIniFile.WriteInteger( 'Vectors','NewsUUMIME', NewsUUMIMEVector );
  2531.   TheICCIniFile.WriteInteger( 'Vectors','NewsInitUD', NewsInitialUpdateVector );
  2532.   TheICCIniFile.WriteInteger( 'Vectors','EMPWControl', EMPasswordControlVector );
  2533.   TheICCIniFile.WriteInteger( 'Vectors','EMRemDel', EMRemoteDeletionVector );
  2534.   TheICCIniFile.WriteInteger( 'Vectors','EMChoke', EMChokeVector );
  2535.   TheICCIniFile.WriteInteger( 'Vectors','EMInitUD', EMDefaultDownloadVector );
  2536.   TheICCIniFile.WriteInteger( 'Vectors','EMQueue', EMQueueVector );
  2537.   TheICCIniFile.Free;
  2538. end;
  2539.  
  2540. { Procedure to load the FTP Site list }
  2541. procedure TCCINetCCForm.LoadFTPSiteFile;
  2542. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2543.     FTPSLName   : String;             { FTP Site List filename }
  2544.     Counter_1   : Integer;            { Loop counter           }
  2545. begin
  2546.   { Create the sites list list }
  2547.   TheFTPSiteList := TList.Create;
  2548.   { Set up the FTP sites list file name }
  2549.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2550.   { If the FTP Site List exists load it in }
  2551.   if FileExists( FTPSLName ) then
  2552.   begin
  2553.     { set up the file and open it }
  2554.     AssignFile( TheFTPSiteFile , FTPSLName );
  2555.     Reset( TheFTPSiteFile );
  2556.     { read in the records }
  2557.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  2558.     begin
  2559.       { Create the TCRecord }
  2560.       New( TheTCRecord );
  2561.       { Read in the data record }
  2562.       Seek( TheFTPSiteFile , Counter_1 );
  2563.       Read( TheFTPSiteFile , TheTCRecord^ );
  2564.       { Add the record to the list }
  2565.       TheFTPSiteList.Add( TheTCRecord );
  2566.     end;
  2567.     { close the file }
  2568.     CloseFile( TheFTPSiteFile );
  2569.   end
  2570.   else
  2571.   { Otherwise create a default one with a few anonymous sites }
  2572.   begin
  2573.     { create new record }
  2574.     New( TheTCRecord );
  2575.     { fill in its info }
  2576.     with TheTCRecord^ do
  2577.     begin
  2578.       CProfile   := 'Winsite Windows Archive';
  2579.       CIPAddress := 'ftp.winsite.com';
  2580.       CUserName  := 'anonymous';
  2581.       CPassword  := 'guest@nowhere.com';
  2582.       CStartDir  := '/pub';
  2583.     end;
  2584.     { add it to the list }
  2585.     { do it three more times }
  2586.     TheFTPSiteList.Add( TheTCRecord );
  2587.     New( TheTCRecord );
  2588.     with TheTCRecord^ do
  2589.     begin
  2590.       CProfile   := 'Digital Equipment Corp';
  2591.       CIPAddress := 'gatekeeper.dec.com';
  2592.       CUserName  := 'anonymous';
  2593.       CPassword  := 'guest@nowhere.com';
  2594.       CStartDir  := '/pub';
  2595.     end;
  2596.     TheFTPSiteList.Add( TheTCRecord );
  2597.     New( TheTCRecord );
  2598.     with TheTCRecord^ do
  2599.     begin
  2600.       CProfile   := 'Microsoft FTP Site';
  2601.       CIPAddress := 'ftp.microsoft.com';
  2602.       CUserName  := 'anonymous';
  2603.       CPassword  := 'guest@nowhere.com';
  2604.       CStartDir  := '/pub';
  2605.     end;
  2606.     TheFTPSiteList.Add( TheTCRecord );
  2607.     New( TheTCRecord );
  2608.     with TheTCRecord^ do
  2609.     begin
  2610.       CProfile   := 'Oakland MSDOS Archive';
  2611.       CIPAddress := 'oak.oakland.edu';
  2612.       CUserName  := 'anonymous';
  2613.       CPassword  := 'guest@nowhere.com';
  2614.       CStartDir  := '/pub';
  2615.     end;
  2616.     TheFTPSiteList.Add( TheTCRecord );
  2617.     { create the file and write out the data, then close it }
  2618.     AssignFile( TheFTPSiteFile , FTPSLName );
  2619.     Rewrite( TheFTPSiteFile );
  2620.     for Counter_1 := 0 to 3 do
  2621.     begin
  2622.       TheTCRecord :=
  2623.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2624.       Seek( TheFTPSiteFile , Counter_1 );
  2625.       Write( TheFTPSiteFile , TheTCRecord^ );
  2626.     end;
  2627.     CloseFile( TheFTPSiteFile );
  2628.   end;
  2629.   { Create the working copy for use to make safe changes in info dlg }
  2630.   TheWorkingFTPSL := TList.Create;
  2631.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2632.   begin
  2633.     New( TheTCRecord );
  2634.     TheTCRecord^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  2635.     TheWorkingFTPSL.Add( TheTCRecord );
  2636.   end;
  2637. end;
  2638.  
  2639. { Procedure to load the NNTP Site list }
  2640. procedure TCCINetCCForm.LoadNNTPSiteFile;
  2641. var TheNGRecord : PConnectionsRecord; { Generic TCR Pointer    }
  2642.     NNTPSLName  : String;             { NNTP Site List filename }
  2643.     Counter_1   : Integer;            { Loop counter           }
  2644. begin
  2645.   { Create the sites list list }
  2646.   TheNewsServerList := TList.Create;
  2647.   { Set up the FTP sites list file name }
  2648.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2649.   { If the FTP Site List exists load it in }
  2650.   if FileExists( NNTPSLName ) then
  2651.   begin
  2652.     { set up the file and open it }
  2653.     AssignFile( TheNewsServerFile , NNTPSLName );
  2654.     Reset( TheNewsServerFile );
  2655.     { read in the records }
  2656.     for Counter_1 := 0 to FileSize( TheNewsServerFile ) - 1 do
  2657.     begin
  2658.       { Create the TCRecord }
  2659.       New( TheNGRecord );
  2660.       { Read in the data record }
  2661.       Seek( TheNewsServerFile , Counter_1 );
  2662.       Read( TheNewsServerFile , TheNGRecord^ );
  2663.       { Add the record to the list }
  2664.       TheNewsServerList.Add( TheNGRecord );
  2665.     end;
  2666.     { close the file }
  2667.     CloseFile( TheNewsServerFile );
  2668.   end
  2669.   else
  2670.   { Otherwise create a default one with a generic news site (?) }
  2671.   begin
  2672.     { create new record }
  2673.     New( TheNGRecord );
  2674.     { fill in its info }
  2675.     with TheNGRecord^ do
  2676.     begin
  2677.       CProfile   := 'My News Server';
  2678.       CIPAddress := 'news.myprovider.com';
  2679.       CUserName  := '';
  2680.       CPassword  := '';
  2681.       CStartDir  := '';
  2682.     end;
  2683.     { add it to the list }
  2684.     { do it three more times }
  2685.     TheNewsServerList.Add( TheNGRecord );
  2686.     { create the file and write out the data, then close it }
  2687.     AssignFile( TheNewsServerFile , NNTPSLName );
  2688.     Rewrite( TheNewsServerFile );
  2689.     TheNGRecord :=
  2690.        PConnectionsRecord( TheNewsServerList.Items[ 0 ] );
  2691.       Seek( TheNewsServerFile , 0 );
  2692.       Write( TheNewsServerFile , TheNGRecord^ );
  2693.     CloseFile( TheNewsServerFile );
  2694.   end;
  2695.   TheWorkingNSSL := TList.Create;
  2696.   For Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2697.   begin
  2698.     New( TheNGRecord );
  2699.     TheNGRecord^ := PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] )^;
  2700.     TheWorkingNSSL.Add( TheNGRecord );
  2701.   end;
  2702. end;
  2703.  
  2704. { This procedure saves off the FTP Site List }
  2705. procedure TCCINetCCForm.SaveFTPSiteFile;
  2706. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  2707.     FTPSLName   : String;             { FTP Site List filename }
  2708.     Counter_1   : Integer;            { Loop counter           }
  2709. begin
  2710.   { Set up the file name }
  2711.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  2712.   { Assign the file }
  2713.   AssignFile( TheFTPSiteFile , FTPSLName );
  2714.   { Rewrite it }
  2715.   Rewrite( TheFTPSiteFile );
  2716.   { run the list through the procedure }
  2717.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2718.   begin
  2719.     { get the record from the list }
  2720.     TheTCRecord :=
  2721.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  2722.     { Do the seek/write }
  2723.     Seek( TheFTPSiteFile , Counter_1 );
  2724.     Write( TheFTPSiteFile , TheTCRecord^ );
  2725.     { free the record }
  2726.     Dispose( TheTCRecord );
  2727.   end;
  2728.   { Close the file }
  2729.   CloseFile( TheFTPSiteFile );
  2730.   { Free the list pointers }
  2731.   TheFTPSiteList.Free;
  2732.   TheWorkingFTPSL.Free;
  2733. end;
  2734.  
  2735. { This procedure saves off the FTP Site List }
  2736. procedure TCCINetCCForm.SaveNNTPSiteFile;
  2737. var TheNGRecord : PConnectionsRecord; { The TC Record pointer   }
  2738.     NNTPSLName   : String;            { NNTP Site List filename }
  2739.     Counter_1   : Integer;            { Loop counter           }
  2740. begin
  2741.   { Set up the file name }
  2742.   NNTPSLName := NewsPath + '\NNTPSITE.TCR';
  2743.   { Assign the file }
  2744.   AssignFile( TheNewsServerFile , NNTPSLName );
  2745.   { Rewrite it }
  2746.   Rewrite( TheNewsServerFile );
  2747.   { run the list through the procedure }
  2748.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  2749.   begin
  2750.     { get the record from the list }
  2751.     TheNGRecord :=
  2752.      PConnectionsRecord( TheNewsServerList.Items[ Counter_1 ] );
  2753.     { Do the seek/write }
  2754.     Seek( TheNewsServerFile , Counter_1 );
  2755.     Write( TheNewsServerFile , TheNGRecord^ );
  2756.     { free the record }
  2757.     Dispose( TheNGRecord );
  2758.   end;
  2759.   { Close the file }
  2760.   CloseFile( TheNewsServerFile );
  2761.   { Free the list pointers }
  2762.   TheNewsServerList.Free;
  2763.   TheWorkingNSSL.Free;
  2764. end;
  2765.  
  2766. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2767. procedure TCCINetCCForm.SetupFTPSiteLists;
  2768. var Counter_1  : Integer;            { Loop counter        }
  2769. begin
  2770.   { Set up display for main form }
  2771.   CCINetCCForm.Tag := 2;
  2772.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  2773.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2774.   CCINetCCForm.FTP1.Enabled := false;
  2775.   CCINetCCForm.FTP2.Enabled := true;
  2776.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  2777.   CCINetCCForm.Button1.Caption := 'Connect';
  2778.   CCINetCCForm.Label4.Caption := 'Local Dir';
  2779.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  2780.   { Set tag for FTP stuff }
  2781.   CCICInfoDlg.Tag := 2;
  2782.   { set up caption of main label }
  2783.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  2784.   { hide outline panel }
  2785.   CCICInfoDlg.Panel6.Visible := false;
  2786.   { clear the list box }
  2787.   CCICInfoDlg.ListBox2.Clear;
  2788.   CCINetCCForm.ComboBox1.Clear;
  2789.   { add profile strings to the list box }
  2790.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  2791.   begin
  2792.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  2793.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2794.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  2795.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  2796.   end;
  2797.   { Set up caption of special button }
  2798.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2799.   { Start with top record }
  2800.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  2801.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  2802.   { put in data from top record and reset captions }
  2803.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  2804.   begin
  2805.     with CCICInfoDlg do
  2806.     begin
  2807.       Edit1.Text := CProfile;
  2808.       Panel2.Caption := '            Name:';
  2809.       Edit2.Text := CIPAddress;
  2810.       Panel3.Caption := '     IP Address:';
  2811.       Edit3.Text := CUserName;
  2812.       Panel5.Caption := '    User Name:';
  2813.       case PasswordControlVector of
  2814.         1 : Edit4.Text := CPassword;
  2815.         2 : Edit4.Text := '**********';
  2816.       end;
  2817.       Panel8.Caption := '      Password:';
  2818.       Edit5.Text := CStartDir;
  2819.       Panel9.Caption := '    Starting Dir:';
  2820.     end;
  2821.   end;
  2822. end;
  2823.  
  2824. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2825. procedure TCCINetCCForm.SetupNNTPSiteLists;
  2826. begin
  2827.   { Set up display for main form }
  2828.   CCINetCCForm.Tag := 4; { Usenet News Tag }
  2829.   CCINetCCForm.Caption := 'CC Internet Command Center -- Usenet News Mode';
  2830.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  2831.   CCINetCCForm.FTP1.Enabled := true;
  2832.   CCINetCCForm.FTP2.Enabled := false;
  2833.   CCINetCCForm.UsenetNws1.Enabled := false;
  2834.   CCINetCCForm.News1.Enabled := true;
  2835.   CCINetCCForm.Label1.Caption := 'NNTP Server:';
  2836.   CCINetCCForm.Button1.Caption := 'Connect';
  2837.   CCINetCCForm.Label4.Caption := 'SubScribed Groups';
  2838.   CCINetCCForm.Label5.Caption := 'Unread Articles';
  2839.   { Create the working copy for use to make safe changes in info dlg }
  2840. end;
  2841.  
  2842. { This method saves off the Newsgroup and Article Lists }
  2843. procedure TCCINetCCForm.SaveNNTPNewsGroupLists;
  2844. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  2845.     TheNGARecord : PNewsGroupArticleRecord; {  }
  2846.     WorkingList : TList;
  2847.     Counter_1 ,
  2848.     Counter_2   : Integer;          { Loop counter              }
  2849.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  2850.     NNTPARName  : String;           { NNTP NewsRC filename      }
  2851. begin
  2852.   { Abort if no server to select }
  2853.   if ComboBox1.ItemIndex = -1 then exit;
  2854.   { Get number of server in list }
  2855.   WhichServer := ComboBox1.ItemIndex;
  2856.   { Set up the FTP sites list file name }
  2857.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  2858.   { If the FTP Site List exists load it in }
  2859.   { set up the file and open it }
  2860.   AssignFile( TheNewsRCFile , NNTPNGLName );
  2861.   ReWrite( TheNewsRCFile );
  2862.   { read in the records }
  2863.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  2864.   begin
  2865.     { Create the TCRecord }
  2866.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  2867.     { Read in the data record }
  2868.     Seek( TheNewsRCFile , Counter_1 );
  2869.     Write( TheNewsRCFile , TheNGRecord^ );
  2870.     { Add the record to the list }
  2871.     WorkingList := TList( TheNGRecord^.GLTag );
  2872.     if WorkingList.Count > 0 then
  2873.     begin
  2874.       NNTPARName := TheNGRecord^.GFileName;
  2875.       TheNGArticlesList := TList.Create;
  2876.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  2877.       ReWrite( TheNewsArticleFile );
  2878.       for Counter_2 := 0 to WorkingList.Count - 1 do
  2879.       begin
  2880.         TheNGARecord :=
  2881.          PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  2882.         Seek( TheNewsArticleFile , Counter_2 );
  2883.         Write( TheNewsArticleFile , TheNGARecord^ );
  2884.         Dispose( TheNGARecord );
  2885.       end;
  2886.       CloseFile( TheNewsArticleFile );
  2887.     end;
  2888.     WorkingList.Free;
  2889.     Dispose( TheNGRecord );
  2890.   end;
  2891.   { close the file }
  2892.   CloseFile( TheNewsRCFile );
  2893.   { Free the list itself }
  2894.   TheNewsRCList.Free;
  2895. end;
  2896.  
  2897. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  2898. procedure TCCINetCCForm.SetupNNTPNewsGroupLists;
  2899. var TheNGRecord : PNewsGroupRecord; { Generic NGR Pointer       }
  2900.     TheNGARecord : PNewsGroupArticleRecord; {  }
  2901.     Counter_1 ,
  2902.     Counter_2   : Integer;          { Loop counter              }
  2903.     NNTPNGLName ,                   { NewsGroup Articles fname  }
  2904.     NNTPARName  : String;           { NNTP NewsRC filename      }
  2905. begin
  2906.   { Abort if no server to select }
  2907.   if ComboBox1.ItemIndex = -1 then exit;
  2908.   { Get number of server in list }
  2909.   WhichServer := ComboBox1.ItemIndex;
  2910.   { Create the sites list list }
  2911.   TheNewsRCList := TList.Create;
  2912.   { Set up the FTP sites list file name }
  2913.   NNTPNGLName := NewsPath + '\NEWSRC ' + IntToStr( WhichServer ) + '.NRC';
  2914.   { If the FTP Site List exists load it in }
  2915.   if FileExists( NNTPNGLName ) then
  2916.   begin
  2917.     { set up the file and open it }
  2918.     AssignFile( TheNewsRCFile , NNTPNGLName );
  2919.     Reset( TheNewsRCFile );
  2920.     { read in the records }
  2921.     for Counter_1 := 0 to FileSize( TheNewsRCFile ) - 1 do
  2922.     begin
  2923.       { Create the TCRecord }
  2924.       New( TheNGRecord );
  2925.       { Read in the data record }
  2926.       Seek( TheNewsRCFile , Counter_1 );
  2927.       Read( TheNewsRCFile , TheNGRecord^ );
  2928.       { Add the record to the list }
  2929.       TheNewsRCList.Add( TheNGRecord );
  2930.     end;
  2931.     { close the file }
  2932.     CloseFile( TheNewsRCFile );
  2933.   end
  2934.   else
  2935.   { Otherwise create a default one with 3 delphi newsgroups }
  2936.   begin
  2937.     { create new record }
  2938.     New( TheNGRecord );
  2939.     { fill in its info }
  2940.     with TheNGRecord^ do
  2941.     begin
  2942.       GName                := 'Delphi Comps';
  2943.       GRealName            := 'comp.lang.pascal.delphi.components';
  2944.       GLowest              := 0;
  2945.       GHighest             := 0;
  2946.       GPostable            := true;
  2947.       GSubscribed          := true;
  2948.       GTotalArticles       := 0;
  2949.       GTotalAvailable      := 0;
  2950.       GLowestAvailable     := 0;
  2951.       GHighestAvailable    := 0;
  2952.       GTotalUnReadArticles := 0;
  2953.       GIDNumber            := 1;
  2954.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G1.NGR';
  2955.       GLTag                := 0;
  2956.     end;
  2957.     { add it to the list }
  2958.     TheNewsRCList.Add( TheNGRecord );
  2959.     { create new record }
  2960.     New( TheNGRecord );
  2961.     { fill in its info }
  2962.     with TheNGRecord^ do
  2963.     begin
  2964.       GName                := 'Delphi DB';
  2965.       GRealName            := 'comp.lang.pascal.delphi.databases';
  2966.       GLowest              := 0;
  2967.       GHighest             := 0;
  2968.       GPostable            := true;
  2969.       GSubscribed          := true;
  2970.       GTotalArticles       := 0;
  2971.       GTotalAvailable      := 0;
  2972.       GLowestAvailable     := 0;
  2973.       GHighestAvailable    := 0;
  2974.       GTotalUnReadArticles := 0;
  2975.       GIDNumber            := 2;
  2976.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G2.NGR';
  2977.       GLTag                := 0;
  2978.     end;
  2979.     { add it to the list }
  2980.     TheNewsRCList.Add( TheNGRecord );
  2981.     { create new record }
  2982.     New( TheNGRecord );
  2983.     { fill in its info }
  2984.     with TheNGRecord^ do
  2985.     begin
  2986.       GName                := 'Delphi Misc';
  2987.       GRealName            := 'comp.lang.pascal.delphi.misc';
  2988.       GLowest              := 0;
  2989.       GHighest             := 0;
  2990.       GPostable            := true;
  2991.       GSubscribed          := true;
  2992.       GTotalArticles       := 0;
  2993.       GTotalAvailable      := 0;
  2994.       GLowestAvailable     := 0;
  2995.       GHighestAvailable    := 0;
  2996.       GTotalUnReadArticles := 0;
  2997.       GIDNumber            := 3;
  2998.       GFileName            := 'NL' + IntToStr( WhichServer ) + 'G3.NGR';
  2999.       GLTag                := 0;
  3000.     end;
  3001.     { add it to the list }
  3002.     TheNewsRCList.Add( TheNGRecord );
  3003.     { create the file and write out the data, then close it }
  3004.     AssignFile( TheNewsRCFile , NNTPNGLName );
  3005.     Rewrite( TheNewsRCFile );
  3006.     for Counter_1 := 0 to 2 do
  3007.     begin
  3008.       TheNGRecord :=
  3009.        PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3010.       Seek( TheNewsRCFile , Counter_1 );
  3011.       Write( TheNewsRCFile , TheNGRecord^ );
  3012.     end;
  3013.     CloseFile( TheNewsRCFile );
  3014.   end;
  3015.   { Load in Articles Records and create storage lists }
  3016.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3017.   begin
  3018.     NNTPARName := PNewsGroupRecord(
  3019.      TheNewsRCList.Items[ Counter_1 ] )^.GFileName;
  3020.     if FileExists( NewsPath + '\' + NNTPARName ) then
  3021.     begin
  3022.       TheNGArticlesList := TList.Create;
  3023.       AssignFile( TheNewsArticleFile , NewsPath + '\' + NNTPARName );
  3024.       Reset( TheNewsArticleFile );
  3025.       for Counter_2 := 0 to FileSize( TheNewsArticleFile ) - 1 do
  3026.       begin
  3027.         New( TheNGARecord );
  3028.         Seek( TheNewsArticleFile , Counter_2 );
  3029.         Read( TheNewsArticleFile , TheNGARecord^ );
  3030.         TheNGArticlesList.Add( TheNGARecord );
  3031.       end;
  3032.       CloseFile( TheNewsArticleFile );
  3033.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3034.        Longint( TheNGArticlesList );
  3035.     end
  3036.     else
  3037.     begin
  3038.       TheNGArticlesList := TList.Create;
  3039.       PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^.GLTag :=
  3040.        Longint( TheNGArticlesList );
  3041.     end;
  3042.   end;
  3043.   { Create working Newsgroup list for later }
  3044.   TheWorkingNRCSL := TList.Create;
  3045.   For Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3046.   begin
  3047.     New( TheNGRecord );
  3048.     TheNGRecord^ := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] )^;
  3049.     TheWorkingNRCSL.Add( TheNGRecord );
  3050.   end;
  3051. end;
  3052.  
  3053. { This procedure populates LB2 with article subjects for any }
  3054. { available articles for a given newsgroup.                  }
  3055. procedure TCCINetCCForm.PopulateLB2WithArticleHeaders;
  3056. var Counter_1    : Integer;
  3057.     TheNGARecord : PNewsGroupArticleRecord;
  3058.     TempString   : String;
  3059. begin
  3060.   { Clear target list box }
  3061.   ListBox2.Clear;
  3062.   for Counter_1 := 0 to TheNGArticlesList.Count - 1 do
  3063.   begin
  3064.     TheNGARecord :=
  3065.      PNewsGroupArticleRecord( TheNGArticlesList.Items[ Counter_1 ] );
  3066.     TempString := '    [' + IntToStr( Counter_1 ) + '] ' +
  3067.      TheNGARecord^.NGASubject;
  3068.     if TheNGARecord^.NGADownloaded then TempString[ 1 ] :=
  3069.      'D';
  3070.     if TheNGARecord^.NGARead then TempString[ 3 ] := 'R';
  3071.     if TheNGARecord^.NGAPosted then TempString[ 3 ] := 'S';
  3072.     ListBox2.Items.Add( TempString );
  3073.   end;
  3074. end;
  3075.  
  3076. { This procedure swaps in the list of subscribed newsgroups to LB1 }
  3077. { and calls another procedure to populate LB2 with any available   }
  3078. { articles for the newsgroup.                                      }
  3079. procedure TCCINetCCForm.SetupNewsGroupListboxes;
  3080. var Counter_1   : Integer;
  3081.     TempString  : String;
  3082.     TheNGRecord : PNewsGroupRecord;
  3083. begin
  3084.   ListBox1.Clear;
  3085.   ListBox1.Tag := 5;
  3086.   ListBox2.Tag := 5;
  3087.   Label4.Caption := 'NewsGroups';
  3088.   Label5.Caption := 'Articles';
  3089.   if TheNewsRCList.Count = 0 then
  3090.   begin
  3091.     ListBox2.Clear;
  3092.     exit;
  3093.   end;
  3094.   ComboBox1.Clear;
  3095.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3096.   begin
  3097.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  3098.     TempString := TheNGRecord^.GName;
  3099.     ComboBox1.Items.Add( TheNGRecord^.GRealName );
  3100.     if TheNGRecord^.GSubscribed then
  3101.      TempString := '[S] ' + TempString else TempString := '[U] ' + TempString;
  3102.     TempString := TempString + '{' + IntToStr( TheNGRecord^.GTotalNew ) + '}';
  3103.     ListBox1.Items.Add( TempString );
  3104.   end;
  3105.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ 0 ] );
  3106.   TheNGArticlesList := TList( TheNGRecord^.GLTag );
  3107.   PopulateLB2WithArticleHeaders;
  3108.   Label1.Caption := 'NewsGroup:';
  3109.   ComboBox1.ItemIndex := 0;
  3110.   Button1.Caption := 'DL Article(s)';
  3111.   Tag := 5; { Set download vector }
  3112. end;
  3113.  
  3114. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3115. procedure TCCINetCCForm.SetupNNTPServersInfoDisplay;
  3116. var Counter_1  : Integer;            { Loop counter        }
  3117. begin
  3118.   { Set tag for NNTP stuff }
  3119.   CCICInfoDlg.Tag := 4; { Usenet News Tag -- servers }
  3120.   { set up caption of main label }
  3121.   CCICInfoDlg.Label2.Caption := 'News Server Sites';
  3122.   { hide outline panel }
  3123.   CCICInfoDlg.Panel6.Visible := false;
  3124.   CCICInfoDlg.Panel5.Visible := false;
  3125.   CCICInfoDlg.Panel8.Visible := false;
  3126.   CCICInfoDlg.Panel9.Visible := false;
  3127.   { clear the list box }
  3128.   CCICInfoDlg.ListBox2.Clear;
  3129.   CCINetCCForm.ComboBox1.Clear;
  3130.   { add profile strings to the list box }
  3131.   for Counter_1 := 0 to TheNewsServerList.Count - 1 do
  3132.   begin
  3133.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  3134.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3135.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  3136.      TheNewsServerList.Items[ Counter_1 ] )^.CProfile );
  3137.   end;
  3138.   { Set up caption of special button }
  3139.   CCICInfoDlg.Button1.Visible := false;
  3140.   { Start with top record }
  3141.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3142.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  3143.   { put in data from top record and reset captions }
  3144.   with PConnectionsRecord( TheNewsServerList.Items[ 0 ] )^ do
  3145.   begin
  3146.     with CCICInfoDlg do
  3147.     begin
  3148.       Edit1.Text := CProfile;
  3149.       Panel2.Caption := '            Name:';
  3150.       Edit2.Text := CIPAddress;
  3151.       Panel3.Caption := '     IP Address:';
  3152.     end;
  3153.   end;
  3154. end;
  3155.  
  3156. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  3157. procedure TCCINetCCForm.SetupNNTPNewsGroupsInfoDisplay;
  3158. var Counter_1  : Integer;            { Loop counter        }
  3159.     WorkingFileName : String;
  3160.     TheWorkingSL : TStringList;
  3161. begin
  3162.   { Set tag for NNTP stuff }
  3163.   CCICInfoDlg.Tag := 5; { Usenet News Tag -- newsgroups }
  3164.   { set up caption of main label }
  3165.   CCICInfoDlg.Label2.Caption := 'Active NewsGroups';
  3166.   { hide outline panel }
  3167.   CCICInfoDlg.Panel5.Visible := true;
  3168.   CCICInfoDlg.Panel6.Visible := true;
  3169.   CCICInfoDlg.Panel6.Height := 224;
  3170.   CCICInfoDlg.Panel6.Top := 120;
  3171.   CCICInfoDlg.Label1.Caption := 'Available NewsGroups';
  3172.   CCICInfoDlg.Panel8.Visible := false;
  3173.   CCICInfoDlg.Panel9.Visible := false;
  3174.   { clear the list box }
  3175.   CCICInfoDlg.ListBox2.Clear;
  3176.   { add profile strings to the list box }
  3177.   for Counter_1 := 0 to TheNewsRCList.Count - 1 do
  3178.   begin
  3179.     CCICInfoDlg.ListBox2.Items.Add( PNewsGroupRecord(
  3180.      TheNewsRCList.Items[ Counter_1 ] )^.GName );
  3181.   end;
  3182.   { Set up caption of special button }
  3183.   CCICInfoDlg.Button1.Visible := true;
  3184.   CCICInfoDlg.Button1.Caption := 'Toggle Subscription';
  3185.   { Start with top record }
  3186.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  3187.   { put in data from top record and reset captions }
  3188.   with PNewsGroupRecord( TheNewsRCList.Items[ 0 ] )^ do
  3189.   begin
  3190.     with CCICInfoDlg do
  3191.     begin
  3192.       Edit1.Text := GName;
  3193.       Panel2.Caption := 'NG Name:';
  3194.       Edit2.Text := GRealName;
  3195.       Panel3.Caption := 'NG Real Name:';
  3196.       if GSubscribed then
  3197.       Edit3.Text := 'Subscribed' else Edit3.Text := 'UnSubscribed';
  3198.       Panel5.Caption := 'Status:';
  3199.     end;
  3200.   end;
  3201.   if newsgroupListloaded then exit;
  3202.   WorkingFileName := NewsPath + '\NEWSGRP.TXT';
  3203.   if FileExists( WorkingFileName ) then
  3204.   begin
  3205.     if MessageDlg( 'Load News Groups File? (Long operation...)',
  3206.      mtConfirmation,mbYesNoCancel,0) = mrYes then
  3207.     begin
  3208.       CCICInfoDlg.ListBox1.Clear;
  3209.       TheWorkingSL := TStringList.Create;
  3210.       try
  3211.         TheWorkingSL.LoadFromFile( WorkingFileName );
  3212.         CCICInfoDlg.ListBox1.Items.Assign( TheWorkingSL );
  3213.       except
  3214.         MessageDlg( 'News Group List Too Large! Use WordPad/Write to view ' +
  3215.                       NewsPath + '\NEWGRP.TXT' , mtInformation,[mbOK],0);
  3216.         TheWorkingSL.Free;
  3217.         NewsgroupListLoaded := false;
  3218.         exit;
  3219.       end;
  3220.       TheWorkingSL.Free;
  3221.       NewsgroupListLoaded := true;
  3222.     end;
  3223.   end;
  3224. end;
  3225.  
  3226. { This procedure scans a line of UNIX-style text for #10's and }
  3227. { outputs them as lines to the memo. It stops at #0.           }
  3228. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : String;
  3229.                                  TheMemoToAddTo : TMemo   );
  3230. var
  3231.   TextLength ,            { Total chars to output         }
  3232.   Counter_1    : integer; { Loop Index                    }
  3233. begin
  3234.   { Make the target memo visible just in case }
  3235.   TheMemoToAddTo.Visible := true;
  3236.   { Find total chars to output }
  3237.   TextLength := Length( TheTextToAdd );
  3238.   { If none then leave }
  3239.   if TextLength = 0 then exit;
  3240.   { Loop along the string }
  3241.   for Counter_1 := 1 to TextLength do
  3242.   begin
  3243.     { If hit ASCII 10 then assume end of line and output }
  3244.     if TheTextToAdd[ Counter_1 ] = #10 then
  3245.     begin
  3246.       { Use a try loop incase memo fills up }
  3247.       try
  3248.         { Add the line }
  3249.         TheMemoToAddTo.Lines.Add( TheLine );
  3250.       except
  3251.         { If memo fills up }
  3252.         on EOutOfResources do
  3253.         begin
  3254.           { Clear the old data }
  3255.           TheMemoToAddTo.Clear;
  3256.           { Output the new }
  3257.           TheMemoToAddTo.Lines.Add( TheLine );
  3258.         end;
  3259.       end;
  3260.       { clear the output buffer }
  3261.       TheLine := '';
  3262.     end
  3263.     else
  3264.     { Otherwise look for null terminator from Winsock }
  3265.     begin
  3266.       { If don't hit null terminator then add the char to op buffer }
  3267.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3268.       begin
  3269.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3270.       end
  3271.       else break; { Otherwise drop out of the loop }
  3272.     end;
  3273.   end;
  3274. end;
  3275.  
  3276. { This function scans a line of UNIX-style text for #10's and }
  3277. { outputs the first line as its return value,stopping at #0.  }
  3278. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : String ) : String;
  3279. var
  3280.   TheLine      : String;  { Buffer to output current line }
  3281.   TextLength ,            { Total chars to output         }
  3282.   Counter_1    : integer; { Loop Index                    }
  3283. begin
  3284.   { Clear output buffer }
  3285.   TheLine := '';
  3286.   { Find total chars to output }
  3287.   TextLength := Length( TheTextToAdd );
  3288.   { If none then leave }
  3289.   if TextLength = 0 then
  3290.   begin
  3291.     { Return nothing }
  3292.     Result := '';
  3293.     { Leave }
  3294.     exit;
  3295.   end;
  3296.   { Loop along the string }
  3297.   for Counter_1 := 1 to TextLength do
  3298.   begin
  3299.     { If hit ASCII 10 then assume end of line and output }
  3300.     if TheTextToAdd[ Counter_1 ] = #10 then
  3301.     begin
  3302.       { Return first line }
  3303.       Result := TheLine;
  3304.       { Leave }
  3305.       exit;
  3306.     end
  3307.     else
  3308.     { Otherwise look for null terminator from Winsock }
  3309.     begin
  3310.       { If don't hit null terminator then add the char to op buffer }
  3311.       if TheTextToAdd[ Counter_1 ] <> #0 then
  3312.       begin
  3313.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  3314.       end
  3315.       else break; { Otherwise drop out of the loop }
  3316.     end;
  3317.   end;
  3318.   { If hit #0 before #10 return buffer }
  3319.   Result := TheLine;
  3320. end;
  3321.  
  3322. { Show busy cursors }
  3323. procedure TCCINetCCForm.SetHGCursors;
  3324. begin
  3325.   CCInetCCForm.Cursor := crHourGlass;
  3326.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  3327. end;
  3328.  
  3329. { Show normal cursors }
  3330. procedure TCCINetCCForm.SetNormalCursors;
  3331. begin
  3332.   CCInetCCForm.Cursor := crDefault;
  3333.   CCInetCCForm.Memo1.Cursor := crDefault;
  3334. end;
  3335.  
  3336. { Exit method }
  3337. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  3338. begin
  3339.   Close;
  3340. end;
  3341.  
  3342. { This method adds a line to the progress text stringlist  }
  3343. { If an exception occurs, the list is full, and it is auto }
  3344. { saved to the progress text file name, then cleared.      }
  3345. procedure TCCINetCCForm.AddProgressText( WhatText : String );
  3346. begin
  3347.   { Use a try..except loop to catch list overflows }
  3348.   try
  3349.     { Try the normal add }
  3350.     ProgressList.Add( WhatText );
  3351.   except
  3352.     { Any list error is assumed to be a list overflow }
  3353.     on EListError do
  3354.     begin
  3355.       { Save the list to the preset file name }
  3356.       ProgressList.SaveToFile( ProgressFileName );
  3357.       { Clear the list to make more room }
  3358.       ProgressList.Clear;
  3359.       { And redo the add; any further errors will except normally }
  3360.       ProgressList.Add( WhatText );
  3361.     end;
  3362.     { This might happen too! }
  3363.     on EOutOfResources do
  3364.     begin
  3365.       { Save the list to the preset file name }
  3366.       ProgressList.SaveToFile( ProgressFileName );
  3367.       { Clear the list to make more room }
  3368.       ProgressList.Clear;
  3369.       { And redo the add; any further errors will except normally }
  3370.       ProgressList.Add( WhatText );
  3371.     end;
  3372.   end;
  3373. end;
  3374.  
  3375. { This method either adds the progress line to the current memo }
  3376. { or puts it in the status caption at normal colors.            }
  3377. procedure TCCINetCCForm.ShowProgressText( WhatText : String );
  3378. begin
  3379.   { Use the POV to determine where to show progress info }
  3380.   case ProgressOutputVector of
  3381.     POV_MEMO : begin { Output into the memo  }
  3382.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3383.                end;
  3384.     POV_STAT : begin { Output on status line }
  3385.                  { Set panel caption font to black }
  3386.                  Panel1.Font.Color := clBlack;
  3387.                  { Get the first line of text and put in caption }
  3388.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3389.                end;
  3390.   end;
  3391. end;
  3392.  
  3393. { This method is identical with SPT except sets status color to red and beeps }
  3394. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : String );
  3395. begin
  3396.   { Do error beep }
  3397.   MessageBeep( mb_IconExclamation );
  3398.   { Use the POV to determine where to show progress info }
  3399.   case ProgressOutputVector of
  3400.     POV_MEMO : begin { Output into the memo  }
  3401.                  AddNullTermTextToMemo( WhatText , Memo1 );
  3402.                end;
  3403.     POV_STAT : begin { Output on status line }
  3404.                  { Set panel caption font to black }
  3405.                  Panel1.Font.Color := clRed;
  3406.                  { Get the first line of text and put in caption }
  3407.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  3408.                end;
  3409.   end;
  3410. end;
  3411.  
  3412. { This is the boilerplate method used to handle Socket errors gracefully }
  3413. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  3414.                                               ErrorCode  : Integer;
  3415.                                               TheMessage : String   );
  3416. begin
  3417.   { Set the global error code flag }
  3418.   GlobalErrorCode := ErrorCode;
  3419.   { If a timeout error }
  3420.   if ErrorCode = WSAETIMEDOUT then
  3421.   begin
  3422.     { Set the aborted flag }
  3423.     GlobalAbortedFlag := True;
  3424.     { But clear the error code for graceful handling }
  3425.     GlobalErrorCode := 0;
  3426.   end
  3427.   else
  3428.   begin
  3429.     { Otherwise set the progress buffer to the error message }
  3430.     AddProgressText( TheMessage );
  3431.     { And show the progress text as set by option }
  3432.     ShowProgressErrorText( TheMessage );
  3433.   end;
  3434. end;
  3435.  
  3436. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  3437. begin
  3438.   { Create the progress string list }
  3439.   ProgressList := TStringList.Create;
  3440.   { Create the file name for saving the progress list }
  3441.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  3442.   { Default progress output to status line }
  3443.   ProgressOutputVector := POV_STAT;
  3444.   { Set password control stuff }
  3445.   PasswordControlVector := 2;
  3446.   CurrentPasswordString := 'guest@nowhere.com';
  3447.   CurrentRealPWString := 'guest@nowhere.com';
  3448.   NewMessageInProgress := false;
  3449.   EmailLoaded := false;
  3450.   NewsGroupListLoaded := false;
  3451.   { Get Ini file Data }
  3452.   ReadIniData;
  3453.   LoadFTPSiteFile;
  3454.   LoadNNTPSiteFile;
  3455.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  3456.   TheFTPComponent.Parent := CCInetCCForm;
  3457.   TheNNTPComponent := TNNTPComponent.Create( CCInetCCForm );
  3458.   TheNNTPComponent.Parent := CCInetCCForm;
  3459. end;
  3460.  
  3461. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  3462. begin
  3463.   { Free the progress text stringlist if assigned }
  3464.   if assigned( ProgressList ) then ProgressList.Free;
  3465.   { Save off the Ini data }
  3466.   WriteIniData;
  3467.   { Save and remove FTP site list stuff }
  3468.   SaveFTPSiteFile;
  3469.   SaveNNTPSiteFile;
  3470.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  3471.   if Assigned( TheNNTPComponent ) then TheNNTPComponent.Free;
  3472. end;
  3473.  
  3474. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  3475. var
  3476.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3477.   TheData    : String;    { Holder for data                           }
  3478. begin
  3479.   { Create socket; auto calls WSAStartup }
  3480.   TempSocket := TCCSocket.Create( Self );
  3481.   { Do parent just for kicks; no longer needed }
  3482.   TempSocket.Parent := self;
  3483.   { Put in error handler }
  3484.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3485.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  3486.   { Display the Description String }
  3487.   AddProgressText( TheData );
  3488.   { And show the progress text as set by option }
  3489.   ShowProgressText( TheData );
  3490.   { Free the socket; auto calls WSACleanup }
  3491.   TempSocket.Free;
  3492. end;
  3493.  
  3494. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  3495. var
  3496.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3497.   TheData    : String;    { Holder for data                           }
  3498. begin
  3499.   { Create socket; auto calls WSAStartup }
  3500.   TempSocket := TCCSocket.Create( Self );
  3501.   { Do parent just for kicks; no longer needed }
  3502.   TempSocket.Parent := self;
  3503.   { Put in error handler }
  3504.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3505.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  3506.   { Display the Description String }
  3507.   AddProgressText( TheData );
  3508.   { And show the progress text as set by option }
  3509.   ShowProgressText( TheData );
  3510.   { Free the socket; auto calls WSACleanup }
  3511.   TempSocket.Free;
  3512. end;
  3513.  
  3514. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  3515. var
  3516.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  3517.   TheData    : String;    { Holder for data                           }
  3518. begin
  3519.   { Create socket; auto calls WSAStartup }
  3520.   TempSocket := TCCSocket.Create( Self );
  3521.   { Do parent just for kicks; no longer needed }
  3522.   TempSocket.Parent := self;
  3523.   { Put in error handler }
  3524.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  3525.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  3526.   { Display the Description String }
  3527.   AddProgressText( TheData );
  3528.   { And show the progress text as set by option }
  3529.   ShowProgressText( TheData );
  3530.   { Free the socket; auto calls WSACleanup }
  3531.   TempSocket.Free;
  3532. end;
  3533.  
  3534. { This method sets the progress output vector to the memo }
  3535. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  3536. begin
  3537.   { Set the vector }
  3538.   ProgressOutputVector := POV_MEMO;
  3539.   { Keep the menu options consistent }
  3540.   ViewInEditWindow1.Checked := true;
  3541.   ViewInStatusLine1.Checked := false;
  3542. end;
  3543.  
  3544. { This method sets the progress output vector to the status line }
  3545. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  3546. begin
  3547.   { Set the vector }
  3548.   ProgressOutputVector := POV_STAT;
  3549.   { Keep the menus consistent }
  3550.   ViewInEditWindow1.Checked := false;
  3551.   ViewInStatusLine1.Checked := true;
  3552. end;
  3553.  
  3554. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  3555. begin
  3556.   { Set up the dialog parameters }
  3557.   OpenDialog1.Filename := ProgressFileName;
  3558.   OpenDialog1.Title := 'Select Filename for Progress File';
  3559.   OpenDialog1.Filter := 'Text Files|*.txt';
  3560.   { If the dialog is not cancelled then save and clear }
  3561.   if OpenDialog1.Execute then
  3562.   begin
  3563.     ProgressFileName := OpenDialog1.FileName;
  3564.     ProgressList.SaveToFile( ProgressFileName );
  3565.     ProgressList.Clear;
  3566.   end;
  3567. end;
  3568.  
  3569. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  3570. begin
  3571.   { Set up info dialog for IP Address getting }
  3572.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  3573.   CCICInfoDlg.Panel4.Visible := false;
  3574.   CCICInfoDlg.Panel6.Visible := false;
  3575.   CCICInfoDlg.Panel9.Visible := false;
  3576.   CCICInfoDlg.Panel8.Visible := false;
  3577.   CCICInfoDlg.BitBtn2.Visible := false;
  3578.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  3579.   CCICInfoDlg.Button2.Visible := false;
  3580.   CCICInfoDlg.Button3.Visible := false;
  3581.   CCICInfoDlg.Button4.Visible := false;
  3582.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  3583.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  3584.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  3585.   CCICInfoDlg.Edit1.Text := '';
  3586.   CCICInfoDlg.Edit2.Text := '';
  3587.   CCICInfoDlg.Edit3.Text := '';
  3588.   { Set IP Address Mode }
  3589.   CCICInfoDlg.Tag := 1;
  3590.   { Show Modally to get the information }
  3591.   CCICInfoDlg.ShowModal;
  3592.   { Reset the info dialog to default conditions }
  3593.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  3594.   CCICInfoDlg.Panel4.Visible := true;
  3595.   CCICInfoDlg.Panel6.Visible := true;
  3596.   CCICInfoDlg.Panel9.Visible := true;
  3597.   CCICInfoDlg.Panel8.Visible := true;
  3598.   CCICInfoDlg.BitBtn2.Visible := true;
  3599.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  3600.   CCICInfoDlg.Button2.Visible := true;
  3601.   CCICInfoDlg.Button3.Visible := true;
  3602.   CCICInfoDlg.Button4.Visible := true;
  3603.   CCICInfoDlg.Panel2.Caption := '             Name:';
  3604.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  3605.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  3606.   CCICInfoDlg.Edit1.Text := '';
  3607.   CCICInfoDlg.Edit2.Text := '';
  3608.   CCICInfoDlg.Edit3.Text := '';
  3609. end;
  3610.  
  3611. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  3612. begin
  3613.   { Set up the FTP Data displays }
  3614.   SetupFTPSiteLists;
  3615.   ListBox1.Clear;
  3616.   ListBox2.Clear;
  3617. end;
  3618.  
  3619. procedure TCCINetCCForm.FormResize(Sender: TObject);
  3620. begin
  3621.   { Use tag vector to determine what to do }
  3622.   case Tag of
  3623.     { if FTP , make sure two list boxes are same height }
  3624.     2 : begin
  3625.           Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  3626.           Panel4.Width := 185;
  3627.         end;
  3628.     4 : begin
  3629.           Panel6.Height := 118;
  3630.           Panel4.Width := 250;
  3631.         end;
  3632.   end;
  3633. end;
  3634.  
  3635. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  3636. begin
  3637.   { Show Modally to get the information }
  3638.   CCICInfoDlg.ShowModal;
  3639. end;
  3640.  
  3641. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  3642. begin
  3643.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  3644.   CCICPrefsDlg.Tag := 2;
  3645.   CCICPrefsDlg.ShowModal;
  3646. end;
  3647.  
  3648. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  3649. var Counter_1 : Integer;
  3650. begin
  3651.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  3652.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  3653.   begin
  3654.     for Counter_1 := 1 to TheAnonRedialVector do
  3655.     begin
  3656.       DoFTPConnection( PConnectionsRecord(
  3657.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3658.       if TheFTPComponent.Connection_Established then exit;
  3659.     end;
  3660.   end
  3661.   else DoFTPConnection( PConnectionsRecord(
  3662.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  3663. end;
  3664.  
  3665. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  3666. begin
  3667.   case Tag of
  3668.     2 : begin
  3669.           if not TheFTPComponent.Connection_Established then
  3670.            ConnectToSite1Click( Self ) else
  3671.            begin
  3672.              DoFTPDisconnect;
  3673.              TheFTPComponent.Connection_Established := false;
  3674.              DisableFTPMenus;
  3675.            end;
  3676.         end;
  3677.     4 : begin
  3678.           ConnectAndUpdate1Click( Self );
  3679.         end;
  3680.   end;
  3681. end;
  3682.  
  3683. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  3684. begin
  3685.   { Assume valid FTP component and have it send its text into the progress text}
  3686.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  3687. end;
  3688.  
  3689. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  3690. begin
  3691.   DoFTPDisconnect;
  3692.   DisableFTPMenus;
  3693. end;
  3694.  
  3695. procedure TCCINetCCForm.EnableFTPMenus;
  3696. begin
  3697.   Button1.Caption := 'Disconnect';
  3698.   ConnectToSite1.Enabled := false;
  3699.   Disconnect1.Enabled := true;
  3700.   Directory1.Enabled := true;
  3701.   UploadMarked1.Enabled := true;
  3702.   DownloadMarked1.Enabled := true;
  3703. end;
  3704.  
  3705. procedure TCCINetCCForm.DisableFTPMenus;
  3706. begin
  3707.   Button1.Caption := 'Connect';
  3708.   ConnectToSite1.Enabled := true;
  3709.   Disconnect1.Enabled := false;
  3710.   Directory1.Enabled := false;
  3711.   UploadMarked1.Enabled := false;
  3712.   DownloadMarked1.Enabled := false;
  3713.   FTP1.Enabled := true;
  3714.   UseNetNws1.Enabled := true;
  3715.   IPAddress1.Enabled := true;
  3716.   FTP2.Enabled := false;
  3717. end;
  3718.  
  3719. procedure TCCINetCCForm.EnableNNTPMenus;
  3720. begin
  3721.   Button1.Caption := 'Disconnect';
  3722.   ConnectAndUpdate1.Enabled := false;
  3723.   Disconnect2.Enabled := true;
  3724.   CheckNewNews1.Enabled := true;
  3725.   GetMarked1.Enabled := true;
  3726.   Article1.Enabled := true;
  3727.   Post1.Enabled := true;
  3728.   SubScribedNewsgroups1.Enabled := true;
  3729.   Trash1.Enabled := true;
  3730.   Headers1.Enabled := true;
  3731.   DownLoadActiveNewsGroups1.Enabled := true;
  3732. end;
  3733.  
  3734. procedure TCCINetCCForm.DisableNNTPMenus;
  3735. begin
  3736.   Button1.Caption := 'Connect';
  3737.   ConnectAndUpdate1.Enabled := True;
  3738.   Disconnect2.Enabled := false;
  3739.   CheckNewNews1.Enabled := false;
  3740.   GetMarked1.Enabled := false;
  3741.   Article1.Enabled := false;
  3742.   Post1.Enabled := false;
  3743.   SubScribedNewsgroups1.Enabled := false;
  3744.   Trash1.Enabled := false;
  3745.   Headers1.Enabled := false;
  3746.   DownLoadActiveNewsGroups1.Enabled := false;
  3747. end;
  3748.  
  3749. procedure TCCINetCCForm.ToDisplay1Click(Sender: TObject);
  3750. var Counter_1 : Integer;
  3751. begin
  3752.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3753.   begin
  3754.     if Listbox1.Selected[ Counter_1 ] then
  3755.     begin
  3756.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3757.       TheFTPComponent.
  3758.        ReceiveASCIIRemoteFileToMemo( Listbox1.Items[ Counter_1 ] );
  3759.     end;
  3760.   end;
  3761. end;
  3762.  
  3763. procedure TCCINetCCForm.ToFile1Click(Sender: TObject);
  3764. var Counter_1 : Integer;
  3765.     W16Name   : String;
  3766. begin
  3767.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3768.   begin
  3769.     if Listbox1.Selected[ Counter_1 ] then
  3770.     begin
  3771.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3772.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3773.       TheFTPComponent.
  3774.        ReceiveASCIIRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3775.     end;
  3776.   end;
  3777. end;
  3778.  
  3779. procedure TCCINetCCForm.Binary2Click(Sender: TObject);
  3780. var Counter_1 : Integer;
  3781.     W16Name   : String;
  3782. begin
  3783.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3784.   begin
  3785.     if Listbox1.Selected[ Counter_1 ] then
  3786.     begin
  3787.       FileNameToXFer := ListBox1.Items[ Counter_1 ];
  3788.       W16Name := TheFTPComponent.GetWin16Filename( FileNameToXFer );
  3789.       TheFTPComponent.
  3790.        ReceiveBinaryRemoteFile( Listbox1.Items[ Counter_1 ] , W16Name );
  3791.     end;
  3792.   end;
  3793. end;
  3794.  
  3795. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  3796. var TheDir : String;
  3797. begin
  3798.   if ListBox1.ItemIndex = -1 then exit;
  3799.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  3800.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  3801.   begin
  3802.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  3803.     { Put up remote directory via PWD and strip quotes }
  3804.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3805.     { Get the listings of directories and exit OK }
  3806.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3807.   end;
  3808. end;
  3809.  
  3810. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  3811. var TheDir : String;
  3812. begin
  3813.   if ListBox2.ItemIndex = -1 then exit;
  3814.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  3815.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  3816.   if TheDir = '..' then
  3817.   begin
  3818.     ChDir( TheDir );
  3819.   end
  3820.   else
  3821.   begin
  3822.     TheDir := ExpandFileName( TheDir );
  3823.     ChDir( TheDir );
  3824.   end;
  3825.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  3826.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  3827.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  3828.   Label5.Caption := TheDir;
  3829. end;
  3830.  
  3831. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  3832. begin
  3833.   case Tag of
  3834.     2 : begin
  3835.           case DefaultDownLoadVector of
  3836.             1 : Binary2Click( Self );
  3837.             2 : ToFile1Click( Self );
  3838.             3 : Change1Click( Self );
  3839.           end;
  3840.         end;
  3841.   end;
  3842. end;
  3843.  
  3844. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  3845. var WorkingString ,
  3846.     NumberString    : String;
  3847.     TheIDNumber     : Integer;
  3848.     TheNGARecord    : PNewsGroupArticleRecord;
  3849. begin
  3850.   case Tag of
  3851.     2 : begin
  3852.           case DefaultDownLoadVector of
  3853.             1 : Binary1Click( Self );
  3854.             2 : ASCII1Click( Self );
  3855.             3 : ChangeLocal1Click( Self );
  3856.           end;
  3857.         end;
  3858.     5 : begin
  3859.           if ListBox2.Tag <> 5 then exit;
  3860.           if ListBox2.ItemIndex = -1 then exit;
  3861.           WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  3862.           NumberString := TheFTPComponent.StripBrackets( WorkingString );
  3863.           TheIDNumber := StrToInt( NumberString );
  3864.           TheNGARecord := PNewsGroupArticleRecord(
  3865.            TheNGArticlesList.Items[ TheIDNumber ] );
  3866.           if TheNGARecord^.NGADownloaded then
  3867.           begin
  3868.             Memo1.Clear;
  3869.             try
  3870.               Memo1.Lines.LoadFromFile( NewsPath + '\' + TheNGARecord^.NGAArtFileName );
  3871.             except
  3872.               MessageDlg( 'Article Too Large to Load! Use Write to View [' +
  3873.                TheNGARecord^.NGAArtFilename + '.',
  3874.                mtError,[mbOK],0);
  3875.               exit;
  3876.             end;
  3877.             Label1.Caption := 'Subject:';
  3878.             ComboBox1.Text := TheNGARecord^.NGASubject;
  3879.             TheNGARecord^.NGARead := true;
  3880.             WorkingString := ListBox2.Items[ ListBox2.ItemIndex ];
  3881.             WorkingString[ 3 ] := 'R';
  3882.             ListBox2.Items[ ListBox2.ItemIndex ] := WorkingString;
  3883.           end
  3884.           else
  3885.           begin
  3886.             MessageDlg( 'Article Not Downloaded!',mtError,[mbOK],0);
  3887.           end;
  3888.         end;
  3889.   end;
  3890. end;
  3891.  
  3892. procedure TCCINetCCForm.ASCII1Click(Sender: TObject);
  3893. var Counter_1 : Integer;
  3894.     TheDir    : String;
  3895. begin
  3896.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3897.   begin
  3898.     if Listbox2.Selected[ Counter_1 ] then
  3899.     begin
  3900.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3901.       TheFTPComponent.
  3902.        SendASCIILocalFile( Listbox2.Items[ Counter_1 ] );
  3903.     end;
  3904.   end;
  3905.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3906.   { Put up remote directory via PWD and strip quotes }
  3907.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3908.   { Get the listings of directories and exit OK }
  3909.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3910. end;
  3911.  
  3912. procedure TCCINetCCForm.DeleteRemoteFiles1Click(Sender: TObject);
  3913. var Counter_1 : Integer;
  3914.     TheDir    : String;
  3915.     DoAll     : Boolean;
  3916.     TheResult : Integer;
  3917. begin
  3918.   DoAll := false;
  3919.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3920.   begin
  3921.     if Listbox1.Selected[ Counter_1 ] then
  3922.     begin
  3923.       if not DoAll then
  3924.       begin
  3925.         TheResult := MessageDlg( 'Delete Remote File ' +
  3926.          ListBox1.Items[ Counter_1 ] + ' ?',mtConfirmation,
  3927.           [mbYes,mbNo,mbCancel,mbAll],0 );
  3928.         case TheResult of
  3929.           mrYes : ;
  3930.           mrNo  : ;
  3931.           mrCancel : break;
  3932.           mrAll : begin
  3933.                     TheResult := mrYes;
  3934.                     DoAll := true;
  3935.                   end;
  3936.         end;
  3937.       end
  3938.       else TheResult := mrYes;
  3939.       if TheResult = mrYes then TheFTPComponent.
  3940.          DeleteRemoteFile( Listbox1.Items[ Counter_1 ] );
  3941.     end;
  3942.   end;
  3943.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3944.   { Put up remote directory via PWD and strip quotes }
  3945.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3946.   { Get the listings of directories and exit OK }
  3947.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3948. end;
  3949.  
  3950. procedure TCCINetCCForm.Binary1Click(Sender: TObject);
  3951. var Counter_1 : Integer;
  3952.     TheDir    : String;
  3953. begin
  3954.   for Counter_1 := 0 to Listbox2.Items.Count - 1 do
  3955.   begin
  3956.     if Listbox2.Selected[ Counter_1 ] then
  3957.     begin
  3958.       FileNameToXFer := ListBox2.Items[ Counter_1 ];
  3959.       TheFTPComponent.
  3960.        SendBinaryLocalFile( Listbox2.Items[ Counter_1 ] );
  3961.     end;
  3962.   end;
  3963.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3964.   { Put up remote directory via PWD and strip quotes }
  3965.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3966.   { Get the listings of directories and exit OK }
  3967.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3968. end;
  3969.  
  3970. procedure TCCINetCCForm.Delete3Click(Sender: TObject);
  3971. var Counter_1 : Integer;
  3972.     TheDir    : String;
  3973. begin
  3974.   for Counter_1 := 0 to Listbox1.Items.Count - 1 do
  3975.   begin
  3976.     if Listbox1.Selected[ Counter_1 ] then
  3977.     begin
  3978.       if ListBox1.Items[ Counter_1 ] <> '..' then
  3979.        TheFTPComponent.
  3980.         DeleteRemoteDirectory( Listbox1.Items[ Counter_1 ] );
  3981.     end;
  3982.   end;
  3983.   TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  3984.   { Put up remote directory via PWD and strip quotes }
  3985.   Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  3986.   { Get the listings of directories and exit OK }
  3987.   TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  3988. end;
  3989.  
  3990. procedure TCCINetCCForm.Create1Click(Sender: TObject);
  3991. var TheDir : String;
  3992. begin
  3993.   OpenDialog1.Filename := '*.*';
  3994.   OpenDialog1.Title := 'Enter Remote Directory Name';
  3995.   if OpenDialog1.Execute then
  3996.   begin
  3997.     TheFTPComponent.
  3998.      CreateRemoteDirectory( ExtractFileName( OpenDialog1.FileName ));
  3999.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir );
  4000.     { Put up remote directory via PWD and strip quotes }
  4001.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  4002.     { Get the listings of directories and exit OK }
  4003.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  4004.   end;
  4005. end;
  4006.  
  4007. procedure TCCINetCCForm.ListBox1Click(Sender: TObject);
  4008. var TheNGRecord : PNewsGroupRecord;
  4009. begin
  4010.   case ListBox1.Tag of
  4011.     5 : begin
  4012.           if ListBox1.ItemIndex = -1 then exit;
  4013.           TheNGRecord :=
  4014.            PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4015.           TheNGArticlesList := TList( TheNGRecord^.GLTag );
  4016.           PopulateLB2WithArticleHeaders;
  4017.           ComboBox1.ItemIndex := ListBox1.ItemIndex;
  4018.         end;
  4019.   end;
  4020. end;
  4021.  
  4022. procedure TCCINetCCForm.UsenetNws1Click(Sender: TObject);
  4023. begin
  4024.   if TheFTPComponent.Connection_Established then
  4025.   begin
  4026.     MessageDlg( 'Must disconnect from current FTP session first!',
  4027.      mtError,[mbOK],0);
  4028.     exit;
  4029.   end;
  4030.   { Show The NNTP servers display }
  4031.   ListBox1.Clear;
  4032.   ListBox2.Clear;
  4033.   SetupNNTPSiteLists;
  4034.   NewsGroupListLoaded := false;
  4035.   SetupNNTPServersInfoDisplay;
  4036. end;
  4037.  
  4038. procedure TCCINetCCForm.Disconnect2Click(Sender: TObject);
  4039. begin
  4040.   SaveNNTPNewsGroupLists;
  4041.   DoNNTPDisconnect;
  4042.   DisableNNTPMenus;
  4043.   ListBox1.Clear;
  4044.   ListBox2.Clear;
  4045. end;
  4046.  
  4047. procedure TCCINetCCForm.News2Click(Sender: TObject);
  4048. begin
  4049.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 2;
  4050.   CCICPrefsDlg.Tag := 4;
  4051.   CCICPrefsDlg.ShowModal;
  4052. end;
  4053.  
  4054. procedure TCCINetCCForm.ConnectandUpdate1Click(Sender: TObject);
  4055. begin
  4056.   DoNNTPConnection( PConnectionsRecord(
  4057.      TheNewsServerList.Items[ ComboBox1.ItemIndex ] ));
  4058.   if TheNNTPComponent.Connection_Established then
  4059.   begin
  4060.     SetupNNTPNewsGroupLists;
  4061.     if NewsInitialUpdateVector = 1 then
  4062.     begin { Update all active newsgroups }
  4063.       TheNNTPComponent.CheckAllNewNews;
  4064.     end;
  4065.     { Bring up the files with current NG information }
  4066.     SetupNewsGroupListboxes;
  4067.   end;
  4068. end;
  4069.  
  4070. procedure TCCINetCCForm.CheckNewNews1Click(Sender: TObject);
  4071. begin
  4072.   TheNNTPComponent.CheckAllNewNews;
  4073.   SetupNewsGroupListboxes;
  4074. end;
  4075.  
  4076. procedure TCCINetCCForm.NewsServers1Click(Sender: TObject);
  4077. begin
  4078.   { Reset display to NNTP Servers }
  4079.   SetupNNTPServersInfoDisplay;
  4080.   { Show Modally to get the information }
  4081.   CCICInfoDlg.ShowModal;
  4082. end;
  4083.  
  4084. procedure TCCINetCCForm.SubscribedNewsgroups1Click(Sender: TObject);
  4085. begin
  4086.   { Reset display to Usenet Newsgroups }
  4087.   SetupNNTPNewsGroupsInfoDisplay;
  4088.   { Show Modally to get the information }
  4089.   CCICInfoDlg.ShowModal;
  4090.   TheNNTPComponent.CheckAllNewNews;
  4091.   SetupNewsGroupListboxes;
  4092. end;
  4093.  
  4094. procedure TCCINetCCForm.AllReadArticles1Click(Sender: TObject);
  4095. var TheNGRecord : PNewsGroupRecord;
  4096. begin
  4097.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4098.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4099.   SetupNewsGroupListboxes;
  4100. end;
  4101.  
  4102. procedure TCCINetCCForm.AllMarkedArticles1Click(Sender: TObject);
  4103. var TheNGRecord : PNewsGroupRecord;
  4104.     TheNGARecord : PNewsGroupArticleRecord;
  4105.     WorkingList : TList;
  4106.     Counter_1 : Integer;
  4107. begin
  4108.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4109.   WorkingList := TList( TheNGRecord^.GLTag );
  4110.   for Counter_1 := 0 to ListBox2.Items.Count - 1 do
  4111.   begin
  4112.     if ListBox2.Selected[ Counter_1 ] then
  4113.     begin
  4114.       TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  4115.       TheNGARecord^.NGARead := true;
  4116.     end;
  4117.   end;
  4118.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4119.   SetupNewsGroupListboxes;
  4120. end;
  4121.  
  4122. procedure TCCINetCCForm.AllAvailableArticles1Click(Sender: TObject);
  4123. var TheNGRecord : PNewsGroupRecord;
  4124.     TheNGARecord : PNewsGroupArticleRecord;
  4125.     WorkingList : TList;
  4126.     Counter_1  : Integer;
  4127. begin
  4128.   TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4129.   WorkingList := TList( TheNGRecord^.GLTag );
  4130.   for Counter_1 := 0 to ListBox2.Items.Count - 1 do
  4131.   begin
  4132.     TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_1 ] );
  4133.     TheNGARecord^.NGARead := true;
  4134.   end;
  4135.   TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4136.   SetupNewsGroupListboxes;
  4137. end;
  4138.  
  4139. procedure TCCINetCCForm.DownloadActiveNewsgroups1Click(Sender: TObject);
  4140. begin
  4141.   if MessageDlg( 'This will take considerable time. Proceed?',mtConfirmation,
  4142.    mbYesNoCancel,0) = mrYes then
  4143.   begin
  4144.     Memo1.Clear;
  4145.     TheNNTPComponent.GetListofAvailableNewsGroups;
  4146.   end;
  4147. end;
  4148.  
  4149. procedure TCCINetCCForm.Load1Click(Sender: TObject);
  4150. var Memo2 : TMemo;
  4151.     Counter_1 : Integer;
  4152. begin
  4153.   OpenDialog1.Filename := '*.txt';
  4154.   OpenDialog1.Title := 'Select File to load into Memo';
  4155.   if OpenDialog1.Execute then
  4156.   begin
  4157.     Memo2 := TMemo.Create( Self );
  4158.     Memo2.Parent := Self;
  4159.     Memo2.Visible := false;
  4160.     Memo2.Width := Memo1.Width;
  4161.     Memo2.Height := Memo1.Height;
  4162.     Memo2.Lines.LoadFromFile( OpenDialog1.FileName );
  4163.     for Counter_1 := 0 to Memo2.Lines.Count - 1 do
  4164.      Memo1.Lines.Add( Memo2.Lines[ Counter_1 ] );
  4165.     Memo2.Free;
  4166.   end;
  4167. end;
  4168.  
  4169. procedure TCCINetCCForm.Save1Click(Sender: TObject);
  4170. begin
  4171.   SaveDialog1.Filename := '*.txt';
  4172.   SaveDialog1.Title := 'Select File to Save Memo to';
  4173.   if OpenDialog1.Execute then
  4174.   begin
  4175.     Memo1.Lines.SaveToFile( SaveDialog1.FileName );
  4176.   end;
  4177. end;
  4178.  
  4179. procedure TCCINetCCForm.Paths1Click(Sender: TObject);
  4180. begin
  4181.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 3;
  4182.   CCICPrefsDlg.Tag := 3;
  4183.   CCICPrefsDlg.ShowModal;
  4184. end;
  4185.  
  4186. procedure TCCINetCCForm.Cut1Click(Sender: TObject);
  4187. begin
  4188.   Memo1.CutToClipboard;
  4189. end;
  4190.  
  4191. procedure TCCINetCCForm.Copy1Click(Sender: TObject);
  4192. begin
  4193.   Memo1.CopyToClipboard;
  4194. end;
  4195.  
  4196. procedure TCCINetCCForm.CopytoFile1Click(Sender: TObject);
  4197. var TempMemo : TMemo;
  4198. begin
  4199.   TempMemo := TMemo.Create( self );
  4200.   TempMemo.parent := self;
  4201.   Tempmemo.Visible := false;
  4202.   TempMemo.Width := Memo1.Width;
  4203.   TempMemo.Height := Memo1.Height;
  4204.   Memo1.CopyToClipboard;
  4205.   TempMemo.PasteFromClipboard;
  4206.   SaveDialog1.Filename := '*.TXT';
  4207.   SaveDialog1.Title := 'Select File to Save To';
  4208.   if SaveDialog1.Execute then TempMemo.Lines.SaveToFile( SaveDialog1.Filename );
  4209.   TempMemo.Free;
  4210. end;
  4211.  
  4212. procedure TCCINetCCForm.Paste1Click(Sender: TObject);
  4213. begin
  4214.   Memo1.PasteFromClipboard;
  4215. end;
  4216.  
  4217. procedure TCCINetCCForm.PastefromFile1Click(Sender: TObject);
  4218. var TempMemo : TMemo;
  4219. begin
  4220.   TempMemo := TMemo.Create( self );
  4221.   TempMemo.parent := self;
  4222.   Tempmemo.Visible := false;
  4223.   TempMemo.Width := Memo1.Width;
  4224.   TempMemo.Height := Memo1.Height;
  4225.   OpenDialog1.Filename := '*.*';
  4226.   OpenDialog1.Title := 'Select File to Paste From';
  4227.   if OpenDialog1.Execute then TempMemo.Lines.LoadFromFile( OpenDialog1.Filename );
  4228.   TempMemo.SelectAll;
  4229.   TempMemo.CopyToClipboard;
  4230.   Memo1.PasteFromClipboard;
  4231.   TempMemo.Free;
  4232. end;
  4233.  
  4234. procedure TCCINetCCForm.SpeedButton5Click(Sender: TObject);
  4235. begin
  4236.   case Tag of
  4237.     5 : AllMarkedArticles1Click( Self );
  4238.   end;
  4239. end;
  4240.  
  4241. procedure TCCINetCCForm.SpeedButton1Click(Sender: TObject);
  4242. begin
  4243.   case Tag of
  4244.     5 : begin
  4245.           if ListBox2.Items.Count = 0 then exit;
  4246.           Listbox2.multiselect := false;
  4247.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4248.           ListBox2.ItemIndex := Listbox2.ItemIndex - 1;
  4249.           if ListBox2.Itemindex < 0 then
  4250.            Listbox2.Itemindex := ListBox2.Items.Count - 1;
  4251.           ListBox2DblClick( Self );
  4252.           ListBox2.Multiselect := true;
  4253.           ListBox2.SetFocus;
  4254.         end;
  4255.   end;
  4256. end;
  4257.  
  4258. procedure TCCINetCCForm.SpeedButton2Click(Sender: TObject);
  4259. begin
  4260.   case Tag of
  4261.     5 : begin
  4262.           if ListBox2.Items.Count = 0 then exit;
  4263.           ListBox2.MultiSelect := false;
  4264.           If ListBox2.ItemIndex = -1 then ListBox2.ItemIndex := 0;
  4265.           ListBox2.ItemIndex := Listbox2.ItemIndex + 1;
  4266.           if ListBox2.Itemindex > ListBox2.Items.Count - 1 then
  4267.            Listbox2.Itemindex := 0;
  4268.           ListBox2DblClick( Self );
  4269.           ListBox2.MultiSelect := true;
  4270.           ListBox2.SetFocus;
  4271.         end;
  4272.   end;
  4273. end;
  4274.  
  4275. procedure TCCINetCCForm.ListBox2Click(Sender: TObject);
  4276. var TheWorkingList : TList;
  4277.     TheNGARecord : PNewsGroupArticleRecord;
  4278.     TheNGRecord : PNewsGroupRecord;
  4279.     TheWorkingName : String;
  4280. begin
  4281.   if ListBox2.Tag = 9 then
  4282.   begin
  4283.     TheNGRecord :=
  4284.      PNewsGroupRecord( TheNewsRCList.Items[ ListBox1.ItemIndex ] );
  4285.     TheWorkingList := TList( TheNGRecord^.GLTag );
  4286.     TheNGARecord := PNewsGroupArticleRecord(
  4287.      TheWorkingList.Items[ ListBox2.ItemIndex ] );
  4288.     TheWorkingName := NewsPath + '\' + TheNGARecord^.NGAArtFileName;
  4289.     TheUUDecodeList.Add( TheWorkingName );
  4290.     exit;
  4291.   end;
  4292.   case Tag of
  4293.     5 : begin
  4294.           If ListBox2.Items.Count = 0 then exit;
  4295.           ComboBox1.Text := ListBox2.Items[ ListBox2.ItemIndex ];
  4296.         end;
  4297.   end;
  4298. end;
  4299.  
  4300. procedure TCCINetCCForm.AbortNewsgroupDownload1Click(Sender: TObject);
  4301. begin
  4302.   GlobalAbortedFlag := true;
  4303. end;
  4304.  
  4305. procedure TCCINetCCForm.Marked1Click(Sender: TObject);
  4306. var Counter_1,
  4307.     Counter_2   : Integer;
  4308.     TheNGRecord : PNewsGroupRecord;
  4309.     TheNGARecord : PNewsGroupArticleRecord;
  4310.     WorkingList : TList;
  4311. begin
  4312.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4313.   begin
  4314.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4315.     if (( TheNGRecord^.GSubscribed ) and ( ListBox1.Selected[ Counter_1 ] )) then
  4316.     begin
  4317.       WorkingList := TList( TheNGRecord^.GLTag );
  4318.       for Counter_2 := 0 to ListBox2.Items.Count - 1 do
  4319.       begin
  4320.         TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  4321.         TheNGARecord^.NGARead := true;
  4322.       end;
  4323.       TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4324.       TheNGRecord^.GLowest := TheNGRecord^.GHighestAvailable;
  4325.       TheNGRecord^.GHighest := TheNGRecord.GLowest;
  4326.       TheNGRecord^.GTotalNew := 0;
  4327.       TheNGRecord^.GTotalArticles := 0;
  4328.     end;
  4329.   end;
  4330.   SetupNewsGroupListboxes;
  4331. end;
  4332.  
  4333. procedure TCCINetCCForm.All1Click(Sender: TObject);
  4334. var Counter_1,
  4335.     Counter_2   : Integer;
  4336.     TheNGRecord : PNewsGroupRecord;
  4337.     TheNGARecord : PNewsGroupArticleRecord;
  4338.     WorkingList : TList;
  4339. begin
  4340.   for Counter_1 := 0 to ListBox1.Items.Count - 1 do
  4341.   begin
  4342.     TheNGRecord := PNewsGroupRecord( TheNewsRCList.Items[ Counter_1 ] );
  4343.     if TheNGRecord^.GSubscribed then
  4344.     begin
  4345.       WorkingList := TList( TheNGRecord^.GLTag );
  4346.       for Counter_2 := 0 to ListBox2.Items.Count - 1 do
  4347.       begin
  4348.         TheNGARecord := PNewsGroupArticleRecord( WorkingList.Items[ Counter_2 ] );
  4349.         TheNGARecord^.NGARead := true;
  4350.       end;
  4351.       TheNGRecord^.GLowest := TheNGRecord^.GHighestAvailable;
  4352.       TheNGRecord^.GHighest := TheNGRecord.GLowest;
  4353.       TheNGRecord^.GTotalNew := 0;
  4354.       TheNGRecord^.GTotalArticles := 0;
  4355.       TheNNTPComponent.PurgeReadSentArticleListings( TheNGRecord );
  4356.     end;
  4357.   end;
  4358.   SetupNewsGroupListboxes;
  4359. end;
  4360.  
  4361. end.
  4362.  
  4363.